diff options
| -rw-r--r-- | Build.PL | 1 | ||||
| -rw-r--r-- | Changelog | 3 | ||||
| -rw-r--r-- | README | 1 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/IRIS/Stations.pm | 13 | ||||
| -rwxr-xr-x | scripts/acronyms.pl | 21 | ||||
| -rw-r--r-- | t/21-iris-stations.t | 13 |
6 files changed, 26 insertions, 26 deletions
@@ -28,6 +28,7 @@ Module::Build->new( 'List::Compare' => '0.29', 'List::MoreUtils' => 0, 'List::Util' => 0, + 'List::UtilsBy' => 0, 'LWP::UserAgent' => 0, 'Text::LevenshteinXS' => 0, 'XML::LibXML' => 0, @@ -2,9 +2,10 @@ git HEAD * Result: Add info key 900 * Station: Improve get_station matching quality by using the Levenshtein - edit distance instead of simple substring matching + edit distance instead in addition to simple substring matching * new dependency: Text::LevenshteinXS (see README for notes about drop-in replacements) + * new dependency: List::UtilsBy Travel::Status::DE::IRIS 1.02 - Tue May 26 2015 @@ -13,6 +13,7 @@ Dependencies * DateTime::Format::Strptime * List::Compare * List::MoreUtils +* List::UtilsBy * LWP::UserAgent * Text::LevenshteinXS * XML::LibXML diff --git a/lib/Travel/Status/DE/IRIS/Stations.pm b/lib/Travel/Status/DE/IRIS/Stations.pm index 2c8b8b4..87b73e4 100644 --- a/lib/Travel/Status/DE/IRIS/Stations.pm +++ b/lib/Travel/Status/DE/IRIS/Stations.pm @@ -6,6 +6,7 @@ use 5.014; use utf8; use List::Util qw(min); +use List::UtilsBy qw(uniq_by); use List::MoreUtils qw(firstval pairwise); use Text::LevenshteinXS qw(distance); @@ -15271,17 +15272,13 @@ sub get_station_by_name { my @distances = map { distance( $nname, $_->[1] ) } @stations; my $min_dist = min(@distances); - my $minp1_dist = min( grep { $_ != $min_dist } @distances ); my @station_map = pairwise { [ $a, $b ] } @stations, @distances; - # arbitrary selection: edit distance < 5 is probably a typo, >= 5 - # probably means the station does not exist / has an odd name - if ( $min_dist < 5 ) { - return map { $_->[0] } grep { $_->[1] == $min_dist } @station_map; - } + my @substring_matches = grep { $_->[1] =~ m{$name}i } @stations; + my @levenshtein_matches + = map { $_->[0] } grep { $_->[1] == $min_dist } @station_map; - # always return a list when the edit distance is large - return map { $_->[0] } grep { $_->[1] <= $minp1_dist } @station_map; + return uniq_by { $_->[0] } ( @substring_matches, @levenshtein_matches ); } 1; diff --git a/scripts/acronyms.pl b/scripts/acronyms.pl index de79b81..6ac2d16 100755 --- a/scripts/acronyms.pl +++ b/scripts/acronyms.pl @@ -16,6 +16,7 @@ use 5.014; use utf8; use List::Util qw(min); +use List::UtilsBy qw(uniq_by); use List::MoreUtils qw(firstval pairwise); use Text::LevenshteinXS qw(distance); @@ -125,7 +126,7 @@ sub normalize { } sub get_station { - my ( $name ) = @_; + my ($name) = @_; my $ds100_match = firstval { $name eq $_->[0] } @stations; @@ -137,34 +138,30 @@ sub get_station { } sub get_station_by_name { - my ( $name ) = @_; + my ($name) = @_; my $nname = lc($name); - my $actual_match = firstval { $nname eq lc($_->[1]) } @stations; + my $actual_match = firstval { $nname eq lc( $_->[1] ) } @stations; if ($actual_match) { return ($actual_match); } $nname = normalize($nname); - $actual_match = firstval { $nname eq normalize(lc($_->[1])) } @stations; + $actual_match = firstval { $nname eq normalize( lc( $_->[1] ) ) } @stations; if ($actual_match) { return ($actual_match); } my @distances = map { distance( $nname, $_->[1] ) } @stations; my $min_dist = min(@distances); - my $minp1_dist = min( grep { $_ != $min_dist } @distances ); my @station_map = pairwise { [ $a, $b ] } @stations, @distances; - # arbitrary selection: edit distance < 5 is probably a typo, >= 5 - # probably means the station does not exist / has an odd name - if ( $min_dist < 5 ) { - return map { $_->[0] } grep { $_->[1] == $min_dist } @station_map; - } + my @substring_matches = grep { $_->[1] =~ m{$name}i } @stations; + my @levenshtein_matches + = map { $_->[0] } grep { $_->[1] == $min_dist } @station_map; - # always return a list when the edit distance is large - return map { $_->[0] } grep { $_->[1] <= $minp1_dist } @station_map; + return uniq_by { $_->[0] } ( @substring_matches, @levenshtein_matches ); } 1; diff --git a/t/21-iris-stations.t b/t/21-iris-stations.t index c440fd0..b346525 100644 --- a/t/21-iris-stations.t +++ b/t/21-iris-stations.t @@ -2,6 +2,7 @@ use strict; use warnings; use 5.014; +use utf8; use Test::More tests => 11; @@ -59,10 +60,12 @@ is_deeply( is_deeply( [ - [ 'NKL', 'Kirchenlaibach' ], - [ 'KM', 'M\'gladbach Hbf' ], - [ 'XSRC', 'Reichenbach Kt' ] + [ 'EEBE', 'E-Bergeborbeck' ], + [ 'EEBB', 'E-Borbeck' ], + [ 'EEBS', 'E-Borbeck Süd' ], + [ 'EGAR', 'Garbeck' ], + [ 'EWBC', 'Wolbeck' ], ], - [ Travel::Status::DE::IRIS::Stations::get_station('Moenchengladbach Hbf') ], - 'get_station: partial match works (several results for very fuzzy match)' + [ Travel::Status::DE::IRIS::Stations::get_station('Borbeck') ], + 'get_station: partial match with substring and levenshtein' ); |