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

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

-

  • Property svn:executable set to *
File size: 14.8 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#
48
49
50use strict ;
51use warnings ;
52
53use List::Util qw[min max] ;
54use OSM::osm 4.7 ;
55use File::stat;
56use Time::localtime;
57
58my $program = "checktouch.pl" ;
59my $usage = $program . " def.xml file.osm out.htm out.gpx" ;
60my $version = "1.3" ;
61
62my $threshold = 0.005 ; # ~500m 0.5km degrees!
63my $maxDist = 0.002 ; # in km
64my $maxDist2 = 0.001 ; 
65
66my $wayId ; my $wayId1 ; 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 $invalidWays ;
76
77my @check ;
78my @against ;
79my @checkWays ;
80my @againstWays ;
81
82my $time0 = time() ; my $time1 ; my $timeA ;
83my $i ;
84my $key ;
85my $num ;
86my $tag1 ; my $tag2 ;
87my $progress ;
88my $potential ;
89my $checksDone ;
90
91my $html ;
92my $def ;
93my $gpx ;
94my $osmName ;
95my $htmlName ;
96my $defName ;
97my $gpxName ;
98
99my %wayNodesHash ;
100my @neededNodes ;
101my %lon ; my %lat ;
102my %xMax ; my %xMin ; my %yMax ; my %yMin ; 
103my %wayCategory ;
104my %wayHash ;
105my %noExit ;
106my %layer ;
107my %wayCount ;  # number ways using this node
108
109my $touches = 0 ;
110my %touchingsHash ;
111
112###############
113# get parameter
114###############
115$defName = shift||'';
116if (!$defName)
117{
118        die (print $usage, "\n");
119}
120
121$osmName = shift||'';
122if (!$osmName)
123{
124        die (print $usage, "\n");
125}
126
127$htmlName = shift||'';
128if (!$htmlName)
129{
130        die (print $usage, "\n");
131}
132
133$gpxName = shift||'';
134if (!$gpxName)
135{
136        $gpxName = $htmlName ;
137        $gpxName =~ s/htm/gpx/ ;
138}
139
140print "\n$program $version for file $osmName\n\n" ;
141
142
143##################
144# read definitions
145##################
146
147print "read definitions file $defName...\n" ;
148open ($def, , "<", $defName) or die "definition file $defName not found" ;
149
150while (my $line = <$def>) {
151        #print "read line: ", $line, "\n" ;
152        my ($k)   = ($line =~ /^\s*<k=[\'\"]([:\w\s\d]+)[\'\"]/); # get key
153        my ($v) = ($line =~ /^.+v=[\'\"]([:\w\s\d]+)[\'\"]/);       # get value
154       
155        if ($k and defined ($v)) {
156                #print "key: ", $k, "\n" ;
157                #print "val: ", $v, "\n" ;
158
159                if ($k eq "check") {
160                        push @check, $v ;
161                }
162                if ($k eq "against") {
163                        push @against, $v ;
164                }
165        }
166}
167
168close ($def) ;
169
170
171print "Check ways: " ;
172foreach (@check) { print $_, " " ;} print "\n" ;
173print "Against: " ;
174foreach (@against) { print $_, " " ;} print "\n\n" ;
175
176
177
178######################
179# skip all nodes first
180######################
181openOsmFile ($osmName) ;
182print "pass1: skipping nodes...\n" ;
183skipNodes () ;
184
185
186#############################
187# identify check/against ways
188#############################
189print "pass1: identify check ways...\n" ;
190($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
191if ($wayId != -1) {
192        @wayNodes = @$aRef1 ;
193        @wayTags = @$aRef2 ;
194}
195while ($wayId != -1) { 
196        $wayCount++ ;
197        if (scalar (@wayNodes) >= 2) {
198
199
200                my $found = 0 ;
201                my $layerTemp = "0" ;
202                foreach $tag1 (@wayTags) {
203                        if (grep (/layer:/, $tag1)) { $layerTemp = $tag1 ; $layerTemp =~ s/layer:// ; }
204                        foreach $tag2 (@against) {
205                                if ($tag1 eq $tag2) { $found = 1 ; }
206                        }
207                }
208
209                my $correctLayer = 0 ;
210                foreach (-5..5) { 
211                        if ($layerTemp eq $_) { $correctLayer = 1 ;} 
212                }
213                if ( ! $correctLayer ) {
214                        print "incorrect layer tag \"$layerTemp\" - will be set to 0.\n" ;
215                        $layerTemp = 0 ;
216                }
217
218                if ($found) {
219                        $againstWayCount++ ;
220                        push @againstWays, $wayId ;
221                        @{$wayNodesHash{$wayId}} = @wayNodes ;
222                        push @neededNodes, @wayNodes ;
223                        $layer{$wayId} = $layerTemp ;
224                        $wayCategory{$wayId} = 2 ;
225                        foreach my $node (@wayNodes) { $wayCount{$node}++ ; }
226                }
227
228                $found = 0 ;
229                foreach $tag1 (@wayTags) {
230                        foreach $tag2 (@check) {
231                                if ($tag1 eq $tag2) { $found = 1 ; }
232                        }
233                }
234                if ($found)  { 
235                        push @checkWays, $wayId ; 
236                        $checkWayCount++ ;
237                        @{$wayNodesHash{$wayId}} = @wayNodes ;
238                        push @neededNodes, @wayNodes ;
239                        $layer{$wayId} = $layerTemp ;
240                        $wayCategory{$wayId} = 1 ;
241                        foreach my $node (@wayNodes) { $wayCount{$node}++ ; }
242                }
243        }
244        else {
245                #print "invalid way (one node only): ", $wayId, "\n" ;
246                $invalidWays++ ;
247        }
248
249        # next way
250        ($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
251        if ($wayId != -1) {
252                @wayNodes = @$aRef1 ;
253                @wayTags = @$aRef2 ;
254        }
255}
256
257closeOsmFile () ;
258
259print "number total ways: $wayCount\n" ;
260print "number invalid ways (1 node only): $invalidWays\n" ;
261print "number check ways: $checkWayCount\n" ;
262print "number against ways: $againstWayCount\n" ;
263
264
265
266######################
267# get node information
268######################
269print "pass2: get node information...\n" ;
270openOsmFile ($osmName) ;
271
272@neededNodes = sort { $a <=> $b } @neededNodes ;
273
274($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
275if ($nodeId != -1) {
276        @nodeTags = @$aRef1 ;
277}
278
279while ($nodeId != -1) {
280        my $needed = 0 ;
281
282        $needed = binSearch ($nodeId, \@neededNodes ) ;
283
284        if ($needed >= 0) { 
285                $lon{$nodeId} = $nodeLon ; 
286                $lat{$nodeId} = $nodeLat ; 
287
288                # noExit
289                $noExit{$nodeId} = 0 ;
290                foreach (@nodeTags) {
291                        if (grep /noexit:yes/, $_) {
292                                $noExit{$nodeId} = 1 ;
293                        } 
294                }
295        }
296
297        # next
298        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
299        if ($nodeId != -1) {
300                @nodeTags = @$aRef1 ;
301        }
302}
303
304closeOsmFile () ;
305
306
307
308##########################
309# init areas for checkWays
310##########################
311print "init areas for checkways...\n" ;
312foreach $wayId (@checkWays) {
313        $xMax{$wayId} =  max ($lon{$wayNodesHash{$wayId}[0]}, $lon{$wayNodesHash{$wayId}[-1]}) + $threshold ;
314        $xMin{$wayId} =  min ($lon{$wayNodesHash{$wayId}[0]}, $lon{$wayNodesHash{$wayId}[-1]}) - $threshold ;
315        $yMax{$wayId} =  max ($lat{$wayNodesHash{$wayId}[0]}, $lat{$wayNodesHash{$wayId}[-1]}) + $threshold ;
316        $yMin{$wayId} =  min ($lat{$wayNodesHash{$wayId}[0]}, $lat{$wayNodesHash{$wayId}[-1]}) - $threshold ;
317}
318
319###############
320# init way hash
321###############
322foreach $wayId (@checkWays) {
323        my $hashValue = hashValue ($lon{$wayNodesHash{$wayId}[0]}, $lat{$wayNodesHash{$wayId}[0]}) ;
324        push (@{$wayHash {$hashValue}}, $wayId) ;
325}
326
327
328###############################
329# check for nearly touches
330###############################
331print "check for nearly touching elements...\n" ;
332
333$progress = 0 ;
334$timeA = time() ;
335
336push @againstWays, @checkWays ;
337my $total = scalar (@againstWays) ;
338
339$potential = $total * scalar (@checkWays) ;
340
341foreach $wayId1 (@againstWays) {
342        $progress++ ;
343        if ( ($progress % 1000) == 0 ) {
344                printProgress ($program, $osmName, $timeA, $total, $progress) ;
345        }
346
347        # create temp array according to hash
348        my @temp = () ;
349        my $lo ; my $la ;
350        for ($lo=$lon{$wayNodesHash{$wayId1}[0]}-0.1; $lo<=$lon{$wayNodesHash{$wayId1}[0]}+0.1; $lo=$lo+0.1) {
351                for ($la=$lat{$wayNodesHash{$wayId1}[0]}-0.1; $la<=$lat{$wayNodesHash{$wayId1}[0]}+0.1; $la=$la+0.1) {
352                        if ( defined @{$wayHash{hashValue($lo,$la)}} ) {
353                                push @temp, @{$wayHash{hashValue($lo,$la)}} ;
354                        }
355                }
356        }
357
358        my $aXMax = max ($lon{$wayNodesHash{$wayId1}[0]}, $lon{$wayNodesHash{$wayId1}[-1]}) ;
359        my $aXMin = min ($lon{$wayNodesHash{$wayId1}[0]}, $lon{$wayNodesHash{$wayId1}[-1]}) ;
360        my $aYMax = max ($lat{$wayNodesHash{$wayId1}[0]}, $lat{$wayNodesHash{$wayId1}[-1]}) ;
361        my $aYMin = min ($lat{$wayNodesHash{$wayId1}[0]}, $lat{$wayNodesHash{$wayId1}[-1]}) ;
362
363        foreach $wayId2 (@temp) {
364                # check for overlapping "way areas"
365                if ( (checkOverlap ($aXMin, $aYMin, $aXMax, $aYMax, $xMin{$wayId2}, $yMin{$wayId2}, $xMax{$wayId2}, $yMax{$wayId2})) and ($layer{$wayId1} == $layer{$wayId2}) ) {
366                        if ( $wayId1 == $wayId2 ) {
367                                # don't do anything because same way!
368                        }
369                        else {
370                                $checksDone++ ;
371                                for ($b=0; $b<$#{$wayNodesHash{$wayId2}}; $b++) {
372                                        # check start id1
373                                        if ( ($noExit{$wayNodesHash{$wayId1}[0]} == 0) and ($wayCount{$wayNodesHash{$wayId1}[0]} == 1 ) ) {
374                                                if ( ($wayNodesHash{$wayId1}[0] != $wayNodesHash{$wayId2}[$b]) and ($wayNodesHash{$wayId1}[0] != $wayNodesHash{$wayId2}[$b+1]) ) {
375                                                        my ($d1) = shortestDistance ($lon{$wayNodesHash{$wayId2}[$b]},
376                                                                                        $lat{$wayNodesHash{$wayId2}[$b]},
377                                                                                        $lon{$wayNodesHash{$wayId2}[$b+1]},
378                                                                                        $lat{$wayNodesHash{$wayId2}[$b+1]},
379                                                                                        $lon{$wayNodesHash{$wayId1}[0]}, 
380                                                                                        $lat{$wayNodesHash{$wayId1}[0]} ) ;
381                                                        if ($d1 < $maxDist) {
382                                                                $touches++ ;
383                                                                @{$touchingsHash{$touches}} = ($lon{$wayNodesHash{$wayId1}[0]}, $lat{$wayNodesHash{$wayId1}[0]}, $wayId1, $wayId2, $d1) ;
384                                                        }
385                                                }
386                                        }
387
388                                        # check end id1
389                                        if ( ($noExit{$wayNodesHash{$wayId1}[-1]} == 0) and ($wayCount{$wayNodesHash{$wayId1}[-1]} == 1 ) ) {
390                                                if ( ($wayNodesHash{$wayId1}[-1] != $wayNodesHash{$wayId2}[$b]) and ($wayNodesHash{$wayId1}[-1] != $wayNodesHash{$wayId2}[$b+1]) ) {
391                                                        my ($d1) = shortestDistance ($lon{$wayNodesHash{$wayId2}[$b]},
392                                                                                        $lat{$wayNodesHash{$wayId2}[$b]},
393                                                                                        $lon{$wayNodesHash{$wayId2}[$b+1]},
394                                                                                        $lat{$wayNodesHash{$wayId2}[$b+1]},
395                                                                                        $lon{$wayNodesHash{$wayId1}[-1]}, 
396                                                                                        $lat{$wayNodesHash{$wayId1}[-1]} ) ;
397                                                        if ($d1 < $maxDist) {
398                                                                $touches++ ;
399                                                                @{$touchingsHash{$touches}} = ($lon{$wayNodesHash{$wayId1}[-1]}, $lat{$wayNodesHash{$wayId1}[-1]}, $wayId1, $wayId2, $d1) ;
400                                                        }
401                                                }
402                                        }
403                                } # for
404                        } # categories
405                } # overlap
406        } 
407}
408
409print "potential checks: $potential\n" ;
410print "checks actually done: $checksDone\n" ;
411my $percent = $checksDone / $potential * 100 ;
412printf "work: %2.3f percent\n", $percent ;
413print "touches found: $touches\n" ;
414
415$time1 = time () ;
416
417
418##################
419# PRINT HTML INFOS
420##################
421print "\nwrite HTML tables and GPX file...\n" ;
422
423open ($html, ">", $htmlName) || die ("Can't open html output file") ;
424open ($gpx, ">", $gpxName) || die ("Can't open gpx output file") ;
425
426
427printHTMLiFrameHeader ($html, "Touch Check by Gary68") ;
428printGPXHeader ($gpx) ;
429
430print $html "<H1>Touch Check by Gary68</H1>\n" ;
431print $html "<p>Version ", $version, "</p>\n" ;
432print $html "<H2>Statistics</H2>\n" ;
433print $html "<p>", stringFileInfo ($osmName), "<br>\n" ;
434print $html "number ways total: $wayCount<br>\n" ;
435print $html "number invalid ways (1 node only): $invalidWays<br>\n" ;
436print $html "number check ways: $checkWayCount<br>\n" ;
437print $html "number against ways: $againstWayCount</p>\n" ;
438
439print $html "<p>Check ways: " ;
440foreach (@check) { print $html $_, " " ;} print $html "</p>\n" ;
441print $html "<p>Against: " ;
442foreach (@against) { print $html $_, " " ;} print $html "</p>\n" ;
443
444
445print $html "<H2>Touches found</H2>\n" ;
446print $html "<p>At the given location a node of one way nearly hits another way. Potentially there is a connection missing." ;
447print $html "<table border=\"1\">\n";
448print $html "<tr>\n" ;
449print $html "<th>Line</th>\n" ;
450print $html "<th>WayId1</th>\n" ;
451print $html "<th>WayId2</th>\n" ;
452print $html "<th>Distance</th>\n" ;
453print $html "<th>OSM</th>\n" ;
454print $html "<th>OSB</th>\n" ;
455print $html "<th>JOSM</th>\n" ;
456print $html "<th>Pic</th>\n" ;
457print $html "</tr>\n" ;
458$i = 0 ;
459foreach $key (keys %touchingsHash) {
460        my ($x, $y, $id1, $id2, $dist) = @{$touchingsHash{$key}} ;
461        #print "HTML $x, $y, $id1, $id2\n" ;
462        $i++ ;
463        $dist = $dist * 1000 ; # in meters
464
465        # HTML
466        print $html "<tr>\n" ;
467        print $html "<td>", $i , "</td>\n" ;
468        print $html "<td>", historyLink ("way", $id1) , "</td>\n" ;
469        print $html "<td>", historyLink ("way", $id2) , "</td>\n" ;
470        if ($dist < ($maxDist2*1000)) {
471                printf $html "<td><strong>~ %2.1f m</strong></td>\n", $dist ;
472        }
473        else {
474                printf $html "<td>~ %2.1f m</td>\n", $dist ;
475        }
476        print $html "<td>", osmLink ($x, $y, 16) , "</td>\n" ;
477        print $html "<td>", osbLink ($x, $y, 16) , "</td>\n" ;
478        print $html "<td>", josmLinkSelectWays ($x, $y, 0.01, $id1, $id2), "</td>\n" ;
479        print $html "<td>", picLinkOsmarender ($x, $y, 16), "</td>\n" ;
480        print $html "</tr>\n" ;
481
482        # GPX
483        my $text = "ChkTouch - " . $id1 . "/" . $id2 . " one way nearly hits another" ;
484        printGPXWaypoint ($gpx, $x, $y, $text) ;
485}
486print $html "</table>\n" ;
487print $html "<p>$i lines total</p>\n" ;
488
489
490
491########
492# FINISH
493########
494print $html "<p>", stringTimeSpent ($time1-$time0), "</p>\n" ;
495printHTMLFoot ($html) ;
496printGPXFoot ($gpx) ;
497
498close ($html) ;
499close ($gpx) ;
500
501statistics ( ctime(stat($osmName)->mtime),  $program,  $defName, $osmName,  $checkWayCount,  $i) ;
502
503print "\n$program finished after ", stringTimeSpent ($time1-$time0), "\n\n" ;
504
505
506sub statistics {
507        my ($date, $program, $def, $area, $total, $errors) = @_ ;
508        my $statfile ; my ($statfileName) = "statistics.csv" ;
509
510        if (grep /\.bz2/, $area) { $area =~ s/\.bz2// ; }
511        if (grep /\.osm/, $area) { $area =~ s/\.osm// ; }
512        my ($area2) = ($area =~ /.+\/([\w\-]+)$/ ) ;
513
514        if (grep /\.xml/, $def) { $def =~ s/\.xml// ; }
515        my ($def2) = ($def =~ /([\w\d\_]+)$/ ) ;
516
517        my ($success) = open ($statfile, "<", $statfileName) ;
518
519        if ($success) {
520                print "statfile found. writing stats...\n" ;
521                close $statfile ;
522                open $statfile, ">>", $statfileName ;
523                printf $statfile "%02d.%02d.%4d;", localtime->mday(), localtime->mon()+1, localtime->year() + 1900 ;
524                printf $statfile "%02d/%02d/%4d;", localtime->mon()+1, localtime->mday(), localtime->year() + 1900 ;
525                print $statfile $date, ";" ;
526                print $statfile $program, ";" ;
527                print $statfile $def2, ";" ;
528                print $statfile $area2, ";" ;
529                print $statfile $total, ";" ;
530                print $statfile $errors ;
531                print $statfile "\n" ;
532                close $statfile ;
533        }
534        return ;
535}
Note: See TracBrowser for help on using the repository browser.