ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Geo-LatLon2Place/LatLon2Place.pm
(Generate patch)

Comparing Geo-LatLon2Place/LatLon2Place.pm (file contents):
Revision 1.3 by root, Mon Mar 14 03:26:19 2022 UTC vs.
Revision 1.8 by root, Tue Jun 28 14:46:43 2022 UTC

… …
72use common::sense; 72use common::sense;
73 73
74use Carp (); 74use Carp ();
75 75
76BEGIN { 76BEGIN {
77 our $VERSION = 0.01; 77 our $VERSION = '1.0';
78 78
79 require XSLoader; 79 require XSLoader;
80 XSLoader::load (__PACKAGE__, $VERSION); 80 XSLoader::load (__PACKAGE__, $VERSION);
81 81
82 eval 'sub TORAD() { ' . ((atan2 1,0) / 180) . ' }'; 82 eval 'sub TORAD() { ' . ((atan2 1,0) / 90) . ' }';
83} 83}
84 84
85=item $lookup = Geo::LatLon2Place->new ($path) 85=item $lookup = Geo::LatLon2Place->new ($path)
86 86
87Opens a database created by F<geo-latlon2place-makedb> and return an 87Opens a database created by F<geo-latlon2place-makedb> and return an
… …
106 (my ($magic, $version), $self->[2], $self->[3]) = unpack "a4VVV", cdb_get $self->[1], ""; 106 (my ($magic, $version), $self->[2], $self->[3]) = unpack "a4VVV", cdb_get $self->[1], "";
107 107
108 $magic eq "SRGL" 108 $magic eq "SRGL"
109 or Carp::croak "$path: not a Geo::LatLon2Place file"; 109 or Carp::croak "$path: not a Geo::LatLon2Place file";
110 110
111 $version == 1 111 $version == 2
112 or Carp::croak "$path: version mismatch (got $version, expected 1)"; 112 or Carp::croak "$path: version mismatch (got $version, expected 2)";
113 113
114 $self 114 $self
115} 115}
116 116
117sub DESTROY { 117sub DESTROY {
118 my ($self) = @_; 118 my ($self) = @_;
119 119
120 cdb_free $self->[1]; 120 cdb_free $self->[1];
121} 121}
122 122
123=item $res = $lookup->lookup ($lat $lon[, $radius]) 123=item $res = $lookup->lookup ($lat, $lon[, $radius])
124 124
125Looks up the point in the database that is "nearest" to C<$lat, $lon>, 125Looks up the point in the database that is "nearest" to C<$lat, $lon>,
126search at leats up to C<$radius> kilometres. The default for C<$radius> is 126search at leats up to C<$radius> kilometres. The default for C<$radius> is
127the cell size the database is built with, and this usually works best, so 127the cell size the database is built with, and this usually works best, so
128you usually do not specify this parameter. 128you usually do not specify this parameter.
129 129
130If something is found, the associated data blob (always a binary string) 130If something is found, the associated data blob (always a binary string)
131is returned, otherwise you receive C<undef>. 131is returned, otherwise you receive C<undef>.
132 132
133Unless you specify a cusotrm format, the data blob is actually a UTF-8 133Unless you specify a custom format/extractor when building your database,
134string, so you might want to call C<utf8::decode> on it to get a unicode 134the data blob is actually a UTF-8 string, so you might want to call
135astring. 135C<utf8::decode> on it to get a unicode string:
136 136
137At the moment, the implementation is in pure perl, but will eventually 137 my $res = $db->lookup (47, 37); # near mariupol, UA
138move to C. 138 if (defined $res) {
139 utf8::decode $res;
140 # $res now contains the unicode result
141 }
139 142
140=cut 143=cut
141 144
142sub lookup { 145sub lookup {
143 my ($self, $lat, $lon, $radius) = @_; 146 my ($self, $lat, $lon, $radius) = @_;
144 147
145 $radius ||= $self->[2]; 148 lookup_ext_ $self->[1], $self->[2], $self->[3], $lat, $lon, 0, $radius, 0
146 $radius = int +($radius + $self->[2] - 1) / $self->[2];
147
148 my $coslat = cos abs $lat * TORAD;
149
150 my $blat = int $self->[3] * $coslat;
151 my $cx = int (($lon + 180) * $blat / 360);
152 my $cy = int (($lat + 90) * $self->[3] / 180);
153
154 my ($min, $res) = (1e00);
155
156 for my $y ($cy - $radius .. $cy + $radius) {
157 for my $x ($cx - $radius .. $cx + $radius) {
158 for (unpack "(C/a*)*", cdb_get $self->[1], pack "s< s<", $x, $y) {
159 my ($plat, $plon, $w, $data) = unpack "s< s< C a*";
160 $plat = $plat * ( 90 / 32767);
161 $plon = $plon * (180 / 32767);
162
163 my $dx = ($lon - $plon) * TORAD * $coslat;
164 my $dy = ($lat - $plat) * TORAD;
165 my $d2 = ($dx * $dx + $dy * $dy) * $w;
166
167 $d2 >= $min
168 or ($min, $res) = ($d2, $data);
169 }
170 }
171 }
172
173 $res
174} 149}
175 150
176=back 151=back
177 152
178=head1 ALGORITHM 153=head1 ALGORITHM
… …
190 165
191It will then calculate the (squared) distance to the search coordinate 166It will then calculate the (squared) distance to the search coordinate
192using an approximate euclidean distance on an equireactangular 167using an approximate euclidean distance on an equireactangular
193projection. The squared distance is multiplied with a weight (1..25 for 168projection. The squared distance is multiplied with a weight (1..25 for
194the geonames database, based on population and adminstrative status, 169the geonames database, based on population and adminstrative status,
195always 1 for postcal codes), and the minimum distance wins. 170always 1 for postal codes), and the minimum distance wins.
196 171
197Binning should not introduce errors, but bigger bins can slow down lookup 172Binning should not introduce errors, but bigger bins can slow down lookup
198times due to having to look at more places. The lookup assumes a spherical 173times due to having to look at more places. The lookup assumes a spherical
199shape for the earth, the equirectangular projection stretches distances 174shape for the earth, the equirectangular projection stretches distances
200unevenly and the euclidean distance calculation introduces further 175unevenly and the euclidean distance calculation introduces further
201errors. For typical distance (<< 100km) and the intended usage, these 176errors. For typical distance (<< 100km) and the intended usage, these
202errors should be considered negligible. 177errors should be considered negligible.
203 178
204=head1 SPEED 179=head1 SPEED
205 180
206The current implementation is written in pure perl, and on my machine, 181On my machine, C<lookup> typically does more than a million lookups per
207typically does 10000-200000 lookups per second. The goal for version 1.0 182second - performance varies depending on result density and number of
208is to move the lookup to C. 183indexed points.
209 184
210=head1 TENTATIVE ROADMAP 185=head1 TENTATIVE ROADMAP
211 186
212The database writer should be accessible via a module, so you cna easily 187The database writer should be accessible via a module, so you can easily
213generate your own databases without having to run an external command. 188generate your own databases without having to run an external command.
214 189
215The api might be extended to allow for multiple returns, or nearest 190The API might be extended to allow for multiple lookups, multiple
216neighbour search. 191returns, or nearest neighbour search, or more return values (distance,
192coordinates).
193
194Longer lookups will take advantage of perlmulticore.
217 195
218=head1 PERL MULTICORE SUPPORT 196=head1 PERL MULTICORE SUPPORT
197
198This is not yet implemented:
219 199
220This module supports the perl multicore specification 200This module supports the perl multicore specification
221(L<http://perlmulticore.schmorp.de/>) when doing lookups. 201(L<http://perlmulticore.schmorp.de/>) when doing lookups.
222 202
223=head1 SEE ALSO 203=head1 SEE ALSO

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines