source: subversion/applications/utils/gary68/checktouch.pl @ 26507

Last change on this file since 26507 was 25014, checked in by gary68, 9 years ago

new checktouch.pl, sorted output

  • Property svn:executable set to *
File size: 15.0 KB
Line 
1#
2#
3# checktouch.pl by gary68
4#
5# this program checks an osm file for crossing ways which don't share a common node at the intersection and are on the same layer
6#
7#
8# Copyright (C) 2008, Gerhard Schwanz
9#
10# 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
11# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
17#
18#
19# example definition file:
20# (IMPORTANT: don't enter a tag in both sections!)
21#
22#<XML>
23#  <k="check" v="highway:motorway">
24#  <k="check" v="highway:motorway_link">
25#  <k="check" v="highway:trunk">
26#  <k="check" v="highway:trunk_link">
27#  <k="against" v="highway:primary">
28#  <k="against" v="highway:primary_link">
29#  <k="against" v="highway:secondary">
30#  <k="against" v="highway:tertiary">
31#  <k="against" v="junction:roundabout">
32#</XML>
33#
34# Version 1.0 -002
35# - layer grep changed
36# Version 003
37# - check layer values
38# Version 1.1
39# - stat
40#
41# Version 1.2
42# - stat 2
43#
44# Version 1.3
45# - ignore way starts and ends that are connected
46#
47# Version 1.4
48# - faster parameters
49# - iFrame
50#
51# Version 2.0
52# - quad trees
53#
54# Version 2.1
55# - sort output by lon
56#
57
58use strict ;
59use warnings ;
60
61use List::Util qw[min max] ;
62use OSM::osm 5.0 ;
63use OSM::QuadTree ;
64use File::stat;
65use Time::localtime;
66
67my $program = "checktouch.pl" ;
68my $usage = $program . " def.xml file.osm out.htm out.gpx" ;
69my $version = "2.1" ;
70
71my $maxDist = 0.002 ; # in km
72my $maxDist2 = 0.001 ; 
73
74my $wayId ; my $wayId1 ; my $wayId2 ;
75my $wayUser ; my @wayNodes ; my @wayTags ;
76my $nodeId ; my $nodeId2 ;
77my $nodeUser ; my $nodeLat ; my $nodeLon ; my @nodeTags ;
78my $aRef1 ; my $aRef2 ;
79my $wayCount = 0 ;
80my $againstCount = 0 ;
81my $checkWayCount = 0 ;
82my $againstWayCount = 0 ;
83my $invalidWays ;
84
85my $qt ;
86
87my @check ;
88my @against ;
89my @checkWays ;
90my @againstWays ;
91
92my $time0 = time() ; my $time1 ; my $timeA ;
93my $i ;
94my $key ;
95my $num ;
96my $tag1 ; my $tag2 ;
97my $progress ;
98my $potential ;
99my $checksDone ;
100
101my $html ;
102my $def ;
103my $gpx ;
104my $osmName ;
105my $htmlName ;
106my $defName ;
107my $gpxName ;
108
109my %wayNodesHash ;
110my @neededNodes ;
111my %lon ; my %lat ;
112my %xMax ; my %xMin ; my %yMax ; my %yMin ; 
113my %wayCategory ;
114my %wayHash ;
115my %noExit ;
116my %layer ;
117my %wayCount ;  # number ways using this node
118
119my $touches = 0 ;
120my %touchingsHash ;
121
122###############
123# get parameter
124###############
125$defName = shift||'';
126if (!$defName)
127{
128        die (print $usage, "\n");
129}
130
131$osmName = shift||'';
132if (!$osmName)
133{
134        die (print $usage, "\n");
135}
136
137$htmlName = shift||'';
138if (!$htmlName)
139{
140        die (print $usage, "\n");
141}
142
143$gpxName = shift||'';
144if (!$gpxName)
145{
146        $gpxName = $htmlName ;
147        $gpxName =~ s/htm/gpx/ ;
148}
149
150print "\n$program $version for file $osmName\n\n" ;
151
152
153##################
154# read definitions
155##################
156
157print "read definitions file $defName...\n" ;
158open ($def, , "<", $defName) or die "definition file $defName not found" ;
159
160while (my $line = <$def>) {
161        #print "read line: ", $line, "\n" ;
162        my ($k)   = ($line =~ /^\s*<k=[\'\"]([:\w\s\d]+)[\'\"]/); # get key
163        my ($v) = ($line =~ /^.+v=[\'\"]([:\w\s\d]+)[\'\"]/);       # get value
164       
165        if ($k and defined ($v)) {
166                #print "key: ", $k, "\n" ;
167                #print "val: ", $v, "\n" ;
168
169                if ($k eq "check") {
170                        push @check, $v ;
171                }
172                if ($k eq "against") {
173                        push @against, $v ;
174                }
175        }
176}
177
178close ($def) ;
179
180
181print "Check ways: " ;
182foreach (@check) { print $_, " " ;} print "\n" ;
183print "Against: " ;
184foreach (@against) { print $_, " " ;} print "\n\n" ;
185
186
187
188######################
189# skip all nodes first
190######################
191openOsmFile ($osmName) ;
192print "pass1: skipping nodes...\n" ;
193skipNodes () ;
194
195
196#############################
197# identify check/against ways
198#############################
199print "pass1: identify check ways...\n" ;
200($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
201if ($wayId != -1) {
202        @wayNodes = @$aRef1 ;
203        @wayTags = @$aRef2 ;
204}
205while ($wayId != -1) { 
206        $wayCount++ ;
207        if (scalar (@wayNodes) >= 2) {
208
209
210                my $found = 0 ;
211                my $layerTemp = "0" ;
212                foreach $tag1 (@wayTags) {
213                        if (grep (/layer:/, $tag1)) { $layerTemp = $tag1 ; $layerTemp =~ s/layer:// ; }
214                        foreach $tag2 (@against) {
215                                if ($tag1 eq $tag2) { $found = 1 ; }
216                        }
217                }
218
219                my $correctLayer = 0 ;
220                foreach (-5..5) { 
221                        if ($layerTemp eq $_) { $correctLayer = 1 ;} 
222                }
223                if ( ! $correctLayer ) {
224                        print "incorrect layer tag \"$layerTemp\" - will be set to 0.\n" ;
225                        $layerTemp = 0 ;
226                }
227
228                if ($found) {
229                        $againstWayCount++ ;
230                        push @againstWays, $wayId ;
231                        @{$wayNodesHash{$wayId}} = @wayNodes ;
232                        push @neededNodes, @wayNodes ;
233                        $layer{$wayId} = $layerTemp ;
234                        $wayCategory{$wayId} = 2 ;
235                        foreach my $node (@wayNodes) { $wayCount{$node}++ ; }
236                }
237
238                $found = 0 ;
239                foreach $tag1 (@wayTags) {
240                        foreach $tag2 (@check) {
241                                if ($tag1 eq $tag2) { $found = 1 ; }
242                        }
243                }
244                if ($found)  { 
245                        push @checkWays, $wayId ; 
246                        $checkWayCount++ ;
247                        @{$wayNodesHash{$wayId}} = @wayNodes ;
248                        push @neededNodes, @wayNodes ;
249                        $layer{$wayId} = $layerTemp ;
250                        $wayCategory{$wayId} = 1 ;
251                        foreach my $node (@wayNodes) { $wayCount{$node}++ ; }
252                }
253        }
254        else {
255                #print "invalid way (one node only): ", $wayId, "\n" ;
256                $invalidWays++ ;
257        }
258
259        # next way
260        ($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
261        if ($wayId != -1) {
262                @wayNodes = @$aRef1 ;
263                @wayTags = @$aRef2 ;
264        }
265}
266
267closeOsmFile () ;
268
269print "number total ways: $wayCount\n" ;
270print "number invalid ways (1 node only): $invalidWays\n" ;
271print "number check ways: $checkWayCount\n" ;
272print "number against ways: $againstWayCount\n" ;
273
274
275
276######################
277# get node information
278######################
279print "pass2: get node information...\n" ;
280openOsmFile ($osmName) ;
281
282my $minLon = 999 ;
283my $maxLon = -999 ;
284my $minLat = 999 ;
285my $maxLat = -999 ;
286
287
288@neededNodes = sort { $a <=> $b } @neededNodes ;
289
290($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
291if ($nodeId != -1) {
292        @nodeTags = @$aRef1 ;
293}
294
295while ($nodeId != -1) {
296        my $needed = 0 ;
297
298        $needed = binSearch ($nodeId, \@neededNodes ) ;
299
300        if ($needed >= 0) { 
301                $lon{$nodeId} = $nodeLon ; 
302                $lat{$nodeId} = $nodeLat ; 
303
304                # noExit
305                $noExit{$nodeId} = 0 ;
306                foreach (@nodeTags) {
307                        if (grep /noexit:yes/, $_) {
308                                $noExit{$nodeId} = 1 ;
309                        } 
310                }
311        }
312
313        if ($nodeLon > $maxLon) { $maxLon = $nodeLon ; }
314        if ($nodeLon < $minLon) { $minLon = $nodeLon ; }
315        if ($nodeLat > $maxLat) { $maxLat = $nodeLat ; }
316        if ($nodeLat < $minLat) { $minLat = $nodeLat ; }
317
318        # next
319        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
320        if ($nodeId != -1) {
321                @nodeTags = @$aRef1 ;
322        }
323}
324
325closeOsmFile () ;
326
327$qt = OSM::QuadTree->new (      -xmin => $minLon, 
328                                -xmax => $maxLon, 
329                                -ymin => $minLat, 
330                                -ymax => $maxLat, 
331                                -depth => 8) ;
332
333
334##########################
335# init areas for checkWays
336##########################
337print "init areas for checkways...\n" ;
338
339###############
340# init way hash
341###############
342foreach $wayId (@checkWays) {
343
344        ($xMin{$wayId}, $xMax{$wayId}, $yMin{$wayId}, $yMax{$wayId}) = getArea ( @{$wayNodesHash{$wayId}} );
345
346        $qt->add ($wayId, $xMin{$wayId}, $yMin{$wayId}, $xMax{$wayId}, $yMax{$wayId}) ;
347}
348
349
350###############################
351# check for nearly touches
352###############################
353print "check for nearly touching elements...\n" ;
354
355$progress = 0 ;
356$timeA = time() ;
357
358push @againstWays, @checkWays ;
359my $total = scalar (@againstWays) ;
360
361$potential = $total * scalar (@checkWays) ;
362
363foreach $wayId1 (@againstWays) {
364        $progress++ ;
365        if ( ($progress % 1000) == 0 ) {
366                printProgress ($program, $osmName, $timeA, $total, $progress) ;
367        }
368
369        # create temp array according to hash
370        my ($aXMin, $aXMax, $aYMin, $aYMax) = getArea ( @{$wayNodesHash{$wayId1}} );
371        my $ref = $qt->getEnclosedObjects ($aXMin, $aYMin, $aXMax, $aYMax) ;
372        my @temp = @$ref ;
373
374        foreach $wayId2 (@temp) {
375                # check for overlapping "way areas"
376                if ( (checkOverlap ($aXMin, $aYMin, $aXMax, $aYMax, $xMin{$wayId2}, $yMin{$wayId2}, $xMax{$wayId2}, $yMax{$wayId2})) and ($layer{$wayId1} == $layer{$wayId2}) ) {
377                        if ( $wayId1 == $wayId2 ) {
378                                # don't do anything because same way!
379                        }
380                        else {
381                                $checksDone++ ;
382                                for ($b=0; $b<$#{$wayNodesHash{$wayId2}}; $b++) {
383                                        # check start id1
384                                        if ( ($noExit{$wayNodesHash{$wayId1}[0]} == 0) and ($wayCount{$wayNodesHash{$wayId1}[0]} == 1 ) ) {
385                                                if ( ($wayNodesHash{$wayId1}[0] != $wayNodesHash{$wayId2}[$b]) and ($wayNodesHash{$wayId1}[0] != $wayNodesHash{$wayId2}[$b+1]) ) {
386                                                        my ($d1) = shortestDistance ($lon{$wayNodesHash{$wayId2}[$b]},
387                                                                                        $lat{$wayNodesHash{$wayId2}[$b]},
388                                                                                        $lon{$wayNodesHash{$wayId2}[$b+1]},
389                                                                                        $lat{$wayNodesHash{$wayId2}[$b+1]},
390                                                                                        $lon{$wayNodesHash{$wayId1}[0]}, 
391                                                                                        $lat{$wayNodesHash{$wayId1}[0]} ) ;
392                                                        if ($d1 < $maxDist) {
393                                                                $touches++ ;
394                                                                @{$touchingsHash{$touches}} = ($lon{$wayNodesHash{$wayId1}[0]}, $lat{$wayNodesHash{$wayId1}[0]}, $wayId1, $wayId2, $d1) ;
395                                                        }
396                                                }
397                                        }
398
399                                        # check end id1
400                                        if ( ($noExit{$wayNodesHash{$wayId1}[-1]} == 0) and ($wayCount{$wayNodesHash{$wayId1}[-1]} == 1 ) ) {
401                                                if ( ($wayNodesHash{$wayId1}[-1] != $wayNodesHash{$wayId2}[$b]) and ($wayNodesHash{$wayId1}[-1] != $wayNodesHash{$wayId2}[$b+1]) ) {
402                                                        my ($d1) = shortestDistance ($lon{$wayNodesHash{$wayId2}[$b]},
403                                                                                        $lat{$wayNodesHash{$wayId2}[$b]},
404                                                                                        $lon{$wayNodesHash{$wayId2}[$b+1]},
405                                                                                        $lat{$wayNodesHash{$wayId2}[$b+1]},
406                                                                                        $lon{$wayNodesHash{$wayId1}[-1]}, 
407                                                                                        $lat{$wayNodesHash{$wayId1}[-1]} ) ;
408                                                        if ($d1 < $maxDist) {
409                                                                $touches++ ;
410                                                                @{$touchingsHash{$touches}} = ($lon{$wayNodesHash{$wayId1}[-1]}, $lat{$wayNodesHash{$wayId1}[-1]}, $wayId1, $wayId2, $d1) ;
411                                                        }
412                                                }
413                                        }
414                                } # for
415                        } # categories
416                } # overlap
417        } 
418}
419
420print "potential checks: $potential\n" ;
421print "checks actually done: $checksDone\n" ;
422my $percent = $checksDone / $potential * 100 ;
423printf "work: %2.3f percent\n", $percent ;
424print "touches found: $touches\n" ;
425
426$time1 = time () ;
427
428
429##################
430# PRINT HTML INFOS
431##################
432print "\nwrite HTML tables and GPX file...\n" ;
433
434open ($html, ">", $htmlName) || die ("Can't open html output file") ;
435open ($gpx, ">", $gpxName) || die ("Can't open gpx output file") ;
436
437
438printHTMLiFrameHeader ($html, "Touch Check by Gary68") ;
439printGPXHeader ($gpx) ;
440
441print $html "<H1>Touch Check by Gary68</H1>\n" ;
442print $html "<p>Version ", $version, "</p>\n" ;
443print $html "<H2>Statistics</H2>\n" ;
444print $html "<p>", stringFileInfo ($osmName), "<br>\n" ;
445print $html "number ways total: $wayCount<br>\n" ;
446print $html "number invalid ways (1 node only): $invalidWays<br>\n" ;
447print $html "number check ways: $checkWayCount<br>\n" ;
448print $html "number against ways: $againstWayCount</p>\n" ;
449
450print $html "<p>Check ways: " ;
451foreach (@check) { print $html $_, " " ;} print $html "</p>\n" ;
452print $html "<p>Against: " ;
453foreach (@against) { print $html $_, " " ;} print $html "</p>\n" ;
454
455
456print $html "<H2>Touches found</H2>\n" ;
457print $html "<p>At the given location a node of one way nearly hits another way. Potentially there is a connection missing." ;
458print $html "<table border=\"1\">\n";
459print $html "<tr>\n" ;
460print $html "<th>Line</th>\n" ;
461print $html "<th>WayId1</th>\n" ;
462print $html "<th>WayId2</th>\n" ;
463print $html "<th>Distance</th>\n" ;
464print $html "<th>OSM</th>\n" ;
465print $html "<th>OSB</th>\n" ;
466print $html "<th>JOSM</th>\n" ;
467print $html "<th>Pic</th>\n" ;
468print $html "</tr>\n" ;
469$i = 0 ;
470
471my @sorted = () ;
472foreach $key (keys %touchingsHash) {
473        my ($x, $y, $id1, $id2, $dist) = @{$touchingsHash{$key}} ;
474        push @sorted, [$key, $x] ;
475}
476
477@sorted = sort { $a->[1] <=> $b->[1]} @sorted ;
478
479foreach my $s (@sorted) {
480
481        my $key ;       
482        $key = $s->[0] ;
483
484        my ($x, $y, $id1, $id2, $dist) = @{$touchingsHash{$key}} ;
485        #print "HTML $x, $y, $id1, $id2\n" ;
486        $i++ ;
487        $dist = $dist * 1000 ; # in meters
488
489        # HTML
490        print $html "<tr>\n" ;
491        print $html "<td>", $i , "</td>\n" ;
492        print $html "<td>", historyLink ("way", $id1) , "</td>\n" ;
493        print $html "<td>", historyLink ("way", $id2) , "</td>\n" ;
494        if ($dist < ($maxDist2*1000)) {
495                printf $html "<td><strong>~ %2.1f m</strong></td>\n", $dist ;
496        }
497        else {
498                printf $html "<td>~ %2.1f m</td>\n", $dist ;
499        }
500        print $html "<td>", osmLink ($x, $y, 16) , "</td>\n" ;
501        print $html "<td>", osbLink ($x, $y, 16) , "</td>\n" ;
502        print $html "<td>", josmLinkSelectWays ($x, $y, 0.005, $id1, $id2), "</td>\n" ;
503        print $html "<td>", picLinkOsmarender ($x, $y, 16), "</td>\n" ;
504        print $html "</tr>\n" ;
505
506        # GPX
507        my $text = "ChkTouch - " . $id1 . "/" . $id2 . " one way nearly hits another" ;
508        printGPXWaypoint ($gpx, $x, $y, $text) ;
509}
510print $html "</table>\n" ;
511print $html "<p>$i lines total</p>\n" ;
512
513
514
515########
516# FINISH
517########
518print $html "<p>", stringTimeSpent ($time1-$time0), "</p>\n" ;
519printHTMLFoot ($html) ;
520printGPXFoot ($gpx) ;
521
522close ($html) ;
523close ($gpx) ;
524
525statistics ( ctime(stat($osmName)->mtime),  $program,  $defName, $osmName,  $checkWayCount,  $i) ;
526
527print "\n$program finished after ", stringTimeSpent ($time1-$time0), "\n\n" ;
528
529
530sub statistics {
531        my ($date, $program, $def, $area, $total, $errors) = @_ ;
532        my $statfile ; my ($statfileName) = "statistics.csv" ;
533
534        if (grep /\.bz2/, $area) { $area =~ s/\.bz2// ; }
535        if (grep /\.osm/, $area) { $area =~ s/\.osm// ; }
536        my ($area2) = ($area =~ /.+\/([\w\-]+)$/ ) ;
537
538        if (grep /\.xml/, $def) { $def =~ s/\.xml// ; }
539        my ($def2) = ($def =~ /([\w\d\_]+)$/ ) ;
540
541        my ($success) = open ($statfile, "<", $statfileName) ;
542
543        if ($success) {
544                print "statfile found. writing stats...\n" ;
545                close $statfile ;
546                open $statfile, ">>", $statfileName ;
547                printf $statfile "%02d.%02d.%4d;", localtime->mday(), localtime->mon()+1, localtime->year() + 1900 ;
548                printf $statfile "%02d/%02d/%4d;", localtime->mon()+1, localtime->mday(), localtime->year() + 1900 ;
549                print $statfile $date, ";" ;
550                print $statfile $program, ";" ;
551                print $statfile $def2, ";" ;
552                print $statfile $area2, ";" ;
553                print $statfile $total, ";" ;
554                print $statfile $errors ;
555                print $statfile "\n" ;
556                close $statfile ;
557        }
558        return ;
559}
560sub getArea {
561        my @nodes = @_ ;
562
563        my $minLon = 999 ;
564        my $maxLon = -999 ;
565        my $minLat = 999 ;
566        my $maxLat = -999 ;
567
568
569        foreach my $node (@nodes) {
570                if ($lon{$node} > $maxLon) { $maxLon = $lon{$node} ; }
571                if ($lon{$node} < $minLon) { $minLon = $lon{$node} ; }
572                if ($lat{$node} > $maxLat) { $maxLat = $lat{$node} ; }
573                if ($lat{$node} < $minLat) { $minLat = $lat{$node} ; }
574        }       
575        return ($minLon, $maxLon, $minLat, $maxLat) ;
576}
577
Note: See TracBrowser for help on using the repository browser.