source: subversion/applications/utils/gary68/selfintersecting.pl @ 26199

Last change on this file since 26199 was 24876, checked in by gary68, 9 years ago

better perf for selfintersecting.pl

  • Property svn:executable set to *
File size: 8.6 KB
Line 
1#
2#
3# selfintersecting.pl
4#
5#
6#
7#
8# Copyright (C) 2009, 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
20
21use strict ;
22use warnings ;
23
24
25use OSM::osm 5.0 ;
26
27my $programName = "selfintersecting.pl" ;
28my $usage = "selfintersecting.pl file.osm out.htm out.gpx" ; 
29my $version = "1.4" ;
30
31
32
33my $wayId ;
34my $wayUser ;
35my @wayNodes ;
36my @wayTags ;
37my $nodeId ;
38my $nodeUser ;
39my $nodeLat ;
40my $nodeLon ;
41my @nodeTags ;
42my $aRef1 ;
43my $aRef2 ;
44
45my @problems = () ;
46
47my $wayCount = 0 ;
48my $problems = 0 ;
49my $APIcount = 0 ;
50my $APIerrors = 0 ;
51
52my $osmName ; 
53my $gpxName ; 
54my $htmName ; 
55
56my %lon ; my %lat ;
57
58
59my $time0 ; 
60
61# get parameter
62
63$osmName = shift||'';
64if (!$osmName)
65{
66        die (print $usage, "\n");
67}
68
69$htmName = shift||'';
70if (!$htmName)
71{
72        die (print $usage, "\n");
73}
74
75$gpxName = shift||'';
76if (!$gpxName)
77{
78        die (print $usage, "\n");
79}
80
81
82print "\n$programName $version for file $osmName\n" ;
83print "\n" ;
84print "ATTENTION!\n" ;
85print "----------\n" ;
86print "This program uses API calls.\n" ;
87print "Although generally running this program once on a relatively small planet-excerpt\n" ;
88print "file poses no threat to the API you might be able to disturb the API\n" ;
89print "by running it often or in parallel and on big files.\n" ;
90print "Calls are made at max. 1/sec. (can be coded)\n" ;
91print "\n" ;
92
93$time0 = time() ;
94
95print "read node data...\n" ;
96openOsmFile ($osmName) ;
97($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
98if ($nodeId != -1) {
99        #@nodeTags = @$aRef1 ;
100}
101
102while ($nodeId != -1) {
103
104        $lon{$nodeId} = $nodeLon ; 
105        $lat{$nodeId} = $nodeLat ; 
106
107        # next
108        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
109        if ($nodeId != -1) {
110                #@nodeTags = @$aRef1 ;
111        }
112}
113
114print "done.\n" ;
115
116print "parsing and checking ways...\n" ;
117
118($wayId, $wayUser, $aRef1, $aRef2) = getWay2 () ;
119if ($wayId != -1) {
120        @wayNodes = @$aRef1 ;
121        @wayTags = @$aRef2 ;
122}
123while ($wayId != -1) {
124        if (scalar (@wayNodes) > 3) {
125                $wayCount++ ;
126                if ($wayCount % 1000000 == 0) { print "$wayCount ways processed...\n" ;}
127                my ($tagText) = "" ;
128                my ($highway) = 0 ;
129                foreach my $t (@wayTags) { 
130                        $tagText = $tagText . $t->[0] . ":" . $t->[1] . "<br>" ; 
131                        if ($t->[0] eq "highway") { $highway = 1 ; }
132                }
133
134                $tagText = $tagText . "<br>Nodes: " . scalar (@wayNodes) . "<br><br>Nodes:  @wayNodes<br>" ;
135
136                my %count = () ;
137                foreach my $n (@wayNodes) { $count{$n}++ ; }
138                my ($double) = 0 ; my $doubleError = 0 ;
139                foreach my $n (keys %count) {
140                        if ($count{$n}>1) { $double++ ; }
141                }
142                if ($double > 1) { $doubleError = 1 ; }
143                if ( ($double == 1) and ($wayNodes[0] != $wayNodes[-1]) ) { $doubleError = 1 ; }
144
145                # check highway exception and possibly reset $doubleError
146                my ($doubleNodes) = 0 ;
147                foreach my $n (@wayNodes) {
148                        if ($count{$n} == 2) { $doubleNodes++ ; }
149                        if ($count{$n} > 2) { $doubleNodes = 100 ; } # at least one node used more than twice -> error
150                }
151                if ($doubleNodes == 2) {
152                        if ( ($count{$wayNodes[0]} == 2) and ($count{$wayNodes[-1]} != 2) ) { $doubleError = 0 ; }
153                        if ( ($count{$wayNodes[-1]} == 2) and ($count{$wayNodes[0]} != 2) ) { $doubleError = 0 ; }
154                }
155                if ( ($doubleNodes == 4) and ($count{$wayNodes[0]} == 2) and ($count{$wayNodes[-1]} == 2) ) {
156                         $doubleError = 0 ; 
157                }
158       
159                if ($doubleError) {
160                        $problems++ ;
161                        my $node ;
162                        foreach my $n (@wayNodes[1..$#wayNodes-1]) {
163                                if ($count{$n}>1)  { $node = $n ; }
164                        }
165                        push @problems, [$wayId, 0, 0, $node, "Node used twice", $lon{$node}, $lat{$node}, $tagText] ;
166                }
167                else { # check segments
168                        my $crossingFound = 0 ;
169                        my ($a, $b) ; 
170                        my ($cLon, $cLat, $seg1, $seg2) ;
171                        # print $wayId, " ", $#wayNodes, "\n" ;
172                        for ($a=0; $a<$#wayNodes-1; $a++) {
173                                for ($b=$a + 2; $b<$#wayNodes; $b++) {
174                                        my ($x, $y) = crossing ($lon{$wayNodes[$a]}, 
175                                                                        $lat{$wayNodes[$a]}, 
176                                                                        $lon{$wayNodes[$a+1]}, 
177                                                                        $lat{$wayNodes[$a+1]}, 
178                                                                        $lon{$wayNodes[$b]}, 
179                                                                        $lat{$wayNodes[$b]}, 
180                                                                        $lon{$wayNodes[$b+1]}, 
181                                                                        $lat{$wayNodes[$b+1]}) ;
182                                        if (($x != 0) and ($y != 0)) {
183                                                #print "\nFOUND $wayId $a $b $x $y\n" ;
184                                                #print "number nodes: ", scalar (@wayNodes), "\n" ;
185                                                #print "nodes list: @wayNodes\n" ;
186                                                #print "$wayNodes[$a] $wayNodes[$a+1] $wayNodes[$b] $wayNodes[$b+1]\n" ;
187                                                #print $lon{$wayNodes[$a]}, " ", $lat{$wayNodes[$a]}, " ", $lon{$wayNodes[$a+1]}, " ", $lat{$wayNodes[$a+1]}, "\n" ;
188                                                #print $lon{$wayNodes[$b]}, " ", $lat{$wayNodes[$b]}, " ", $lon{$wayNodes[$b+1]}, " ", $lat{$wayNodes[$b+1]}, "\n" ;
189                                                $crossingFound = 1 ;
190                                                $seg1 = $a ; $seg2 = $b ; $cLon = $x ; $cLat = $y ;
191                                        } # found
192                                } # for
193                        } # for
194
195
196                        if ($crossingFound == 1) {
197                                # check API way data
198                                print "request API data for way $wayId...\n" ;
199                                $APIcount++ ;
200                                sleep (1) ; # don't stress API
201                                my ($id, $u, @nds, @tags, $ndsRef, $tagRef) ;
202                                ($id, $u, $ndsRef, $tagRef) = APIgetWay ($wayId) ;
203                                print "API request finished.\n" ;
204                                @nds = @$ndsRef ; @tags = @$tagRef ;
205                                if ($id == 0) { $APIerrors++ ; }
206                                if ( ( scalar @wayNodes != scalar @nds) and ($wayId == $id) ) { 
207                                        $crossingFound = 0 ; 
208                                        print "WARNING: way $wayId segment crossing but API node count mismatch. Ignoring this way.\n" ;
209                                }
210                                if ($crossingFound == 1) {
211                                        $problems++ ;
212                                        push @problems, [$wayId, $seg1, $seg2, 0, "<p>Intersection at<br>" . $cLon . "<br>" . $cLat . "</p>\n", $cLon, $cLat, $tagText] ;
213                                }
214                        }
215                }
216        }
217       
218        ($wayId, $wayUser, $aRef1, $aRef2) = getWay2 () ;
219        if ($wayId != -1) {
220                @wayNodes = @$aRef1 ;
221                @wayTags = @$aRef2 ;
222        }
223}
224
225closeOsmFile() ;
226
227print "done.\n" ;
228print "$wayCount ways found.\n" ;
229print "$problems problems found.\n" ;
230print "$APIcount API calls.\n" ;
231print "$APIerrors API errors.\n\n" ;
232
233
234my $html ; my $gpx ;
235open ($html, ">", $htmName) || die ("Can't open html output file") ;
236open ($gpx, ">", $gpxName) || die ("Can't open gpx output file") ;
237
238
239printHTMLiFrameHeader ($html, "Self intersecting way Check by Gary68") ;
240printGPXHeader ($gpx) ;
241
242print $html "<H1>Self intersecting way Check by Gary68</H1>\n" ;
243print $html "<p>Version ", $version, "</p>\n" ;
244print $html "<H2>Statistics</H2>\n" ;
245print $html "<p>", stringFileInfo ($osmName), "<br>\n" ;
246print $html "number ways total: $wayCount<br>\n" ;
247print $html "number problems: $problems<br>\n" ;
248print $html "</p>\n" ;
249
250
251print $html "<H2>Data</H2>\n" ;
252print $html "<table border=\"1\">\n";
253print $html "<tr>\n" ;
254print $html "<th>Line</th>\n" ;
255print $html "<th>Way Id (map/highlight)</th>\n" ;
256print $html "<th>Way tags</th>\n" ;
257print $html "<th>Segment 1</th>\n" ;
258print $html "<th>Segment 2</th>\n" ;
259print $html "<th>Node</th>\n" ;
260print $html "<th>Text</th>\n" ;
261print $html "<th>JOSM</th>\n" ;
262print $html "<th>OSM</th>\n" ;
263print $html "<th>OSB</th>\n" ;
264print $html "</tr>\n" ;
265
266my $line = 0 ;
267foreach my $problem (@problems) {
268        $line++ ;
269        my ($lo) = $problem->[5] ;
270        my ($la) = $problem->[6] ;
271       
272        print $html "<tr>\n" ;
273        print $html "<td>", $line , "</td>\n" ;
274        print $html "<td>", historyLink ("way", $problem->[0]), "<br>", osmLinkMarkerWay ($lo, $la, 16, $problem->[0]), "</td>\n"  ;
275        print $html "<td><p>" . $problem->[7] . "</p></td>\n" ;
276        print $html "<td>", $problem->[1], "</td>\n" ;
277        print $html "<td>", $problem->[2], "</td>\n" ;
278        print $html "<td>", historyLink ("node", $problem->[3]), "</td>\n" ;
279        print $html "<td>", $problem->[4], "</td>\n" ;
280        print $html "<td>", josmLinkSelectWays ($lo, $la, 0.01, $problem->[0]), "</td>\n" ;
281        print $html "<td>", osmLink ($lo, $la, 16) , "<br>\n" ;
282        print $html "<td>", osbLink ($lo, $la, 16) , "<br>\n" ;
283        print $html "</tr>\n" ;
284       
285        my ($text) = "Self intersecting way - " . $problem->[0] ;
286        printGPXWaypoint ($gpx, $lo, $la, $text) ;
287}
288
289print $html "</table>\n" ;
290print $html "<p>", stringTimeSpent (time()-$time0), "</p>\n" ;
291
292printHTMLFoot ($html) ;
293printGPXFoot ($gpx) ;
294
295close ($html) ;
296close ($gpx) ;
297
298
299print "\n$programName finished after ", stringTimeSpent (time()-$time0), "\n\n" ;
300
301
302
303
Note: See TracBrowser for help on using the repository browser.