Check for bad interpolations in OSM

osm-interpolation-check.pl

#!/usr/bin/perl -w

use utf8;
use strict;
use Davin::Roads::OSMCommon;
use Data::Dumper;

# Quick script to find interpolations missing address on one end or the other.
# It's tricky because some interpolations are split into multiple ways. 
# As a bonus this script also finds interpolations which are on top of each other or share ways (count > 2);

my $ai = new Davin::Roads::OSMCommon;
my $features = $ai->parse_json;

my %nodes;
my %ways;

# find all the nodes with addresses

foreach my $feature (@$features) {
        next if ($$feature{id} !~ /^node/);
        my $long = $$feature{geometry}{coordinates}[0];
        my $lat = $$feature{geometry}{coordinates}[1];
        my $id = $$feature{id};
        $id =~ s#^node/#n#;
        push (@{$nodes{"$long/$lat"}}, $id);
}

# find all the nodes which have more than one way using them

foreach my $feature (@$features) {
        next if ($$feature{id} !~ /^way/);
        my $count = 0;
        foreach my $coord (@{$$feature{geometry}{coordinates}}) {
                my $long = $$coord[0];
                my $lat = $$coord[1];
                $ways{"$long/$lat"}++;
        }
}

# elimate nodes on ways which are only used once

foreach my $key (keys %ways) {
        delete $ways{$key} if ($ways{$key} == 1);
}

# check the results

foreach my $feature (@$features) {
        next if ($$feature{id} !~ /^way/);
        my $countn = 0;
        my $countw = 0;
        my @objects;
        foreach my $coord (@{$$feature{geometry}{coordinates}}) {
                my $long = $$coord[0];
                my $lat = $$coord[1];
                if (exists $nodes{"$long/$lat"}) {
                        $countn++;
                        push (@objects, @{$nodes{"$long/$lat"}});
                }
                if (exists $ways{"$long/$lat"}) {
                        $countw++;
                }
        }

        if ($countn + $countw != 2) {
                my $object = $$feature{id};
                $object =~ s#^way/#w#;
                my $message = "[IIA] ($object) ";
                $message .= "using (" . join (',', @objects) . ") " if (@objects);
                $message .= "has count_address=<$countn>, and count_other=<$countw> assigned to the interpolation";
                print "$message\n";
        }
}