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

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

faster parameters for hashvalues

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