source: subversion/applications/utils/gary68/selfintersectingDB.pl @ 24893

Last change on this file since 24893 was 24877, checked in by gary68, 9 years ago

new self DB

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