Little useless-useful R functions – Honest geographical location signposts

We have all seen colourful signposts with great cities and their distances – how far each is from this current standpoint.

And fundamental question is, how correct these distances are? Or even, one should ask, how honest a particular signpost is, regarding the current standpoint.

So let’s put this utterly most fundamental question to the test And since it is vacation time, you can grab the R code and check it yourself

Image stumbling upon the post and wanted to check if this post is really relevant for this location. It can be a photo from other side of the world, hanging in the lobby of your holiday hotel And this sure ain’t honest signpost

The R code iterates through each city, finds matching points (where all circles meet) and searches for the nearest location. It uses OpenStreetMap (short: OSM) to extract all the geolocations and looks for possible intersections of all points

geocode_city <- function(city_name) {
 
  url <- modify_url(
    "https://nominatim.openstreetmap.org/search",
    query = list(
      q       = city_name,
      format  = "json",
      limit   = 1
    )
  )
  
  resp <- tryCatch(
    GET(url, user_agent("PointingSignFinder/1.0 (R script)")),
     error = function(e) {
       cat(" Error on endpoint")
       return(NULL)
     }
  )
  
  if (is.null(resp) || http_error(resp)) {
    cat(" Error on http\n")
    return(NULL)
  }
  
  result <- fromJSON(content(resp, as = "text", encoding = "UTF-8"))
  
  if (length(result) == 0) {
    cat("Error on result")
    return(NULL)
  }
  
  lat <- as.numeric(result$lat[1])
  lon <- as.numeric(result$lon[1])
  cat(sprintf(" found: %.4f°, %.4f°\n", lat, lon))
  
  Sys.sleep(1.1)
  
  list(lat = lat, lon = lon, display_name = result$display_name[1])
}


sign_location_finder <- function(cities,
                                 distances,
                                 tolerance = 50,
                                 coarse_res = 0.2,
                                 fine_res   = 0.02,
                                 nearby_radius = 200,
                                 nearby_min_pop = 100000) {
  
  stopifnot(length(cities) == length(distances))
  stopifnot(length(cities) >= 2)
  
  cat("Step 1: Geocoding cities\n")
  coords <- lapply(cities, geocode_city)
  
  failed <- which(sapply(coords, is.null))
  if (length(failed) > 0) {
    stop(sprintf("Location not founc: %s", paste(cities[failed], collapse = ", ")))
  }
  
  sign_data <- data.frame(
    city    = cities,
    lat     = sapply(coords, `[[`, "lat"),
    lon     = sapply(coords, `[[`, "lon"),
    dist_km = distances
  )


print(sign_data[, c("city", "lat", "lon", "dist_km")])
  
max_dist_deg <- max(sign_data$dist_km) / 111
lat_min <- min(sign_data$lat) - max_dist_deg - 5
lat_max <- max(sign_data$lat) + max_dist_deg + 5
lon_min <- min(sign_data$lon) - max_dist_deg * 2 - 5
lon_max <- max(sign_data$lon) + max_dist_deg * 2 + 5
  
 
lat_min <- max(lat_min, -85)
lat_max <- min(lat_max,  85)
lon_min <- max(lon_min, -180)
lon_max <- min(lon_max,  180)
  
cat(sprintf("\nStep 2: Search bounding box: lat [%.1f, %.1f], lon [%.1f, %.1f]\n",
              lat_min, lat_max, lon_min, lon_max))
  
  
  score_point <- function(plat, plon) {
    diffs <- sapply(seq_len(nrow(sign_data)), function(i) {
      d <- distHaversine(
        c(plon, plat),
        c(sign_data$lon[i], sign_data$lat[i])
      ) / 1000
      abs(d - sign_data$dist_km[i])
    })
    max(diffs)
  }
  
  
  cat(sprintf("\nStep 3: Search the grid (%.2f° resolution)...\n", coarse_res))
  grid <- expand.grid(
    lat = seq(lat_min, lat_max, by = coarse_res),
    lon = seq(lon_min, lon_max, by = coarse_res)
  )
  cat(sprintf("Checking %d grid points...\n", nrow(grid)))
  grid$score <- mapply(score_point, grid$lat, grid$lon)
  
  candidates <- grid[grid$score <= tolerance, ]
  cat(sprintf(" Found %d candidate cells within ±%d km tolerance.\n",
              nrow(candidates), tolerance))
  
  coarse_best <- grid[which.min(grid$score), ]
  
  fine_grid <- expand.grid(
    lat = seq(coarse_best$lat - 1, coarse_best$lat + 1, by = fine_res),
    lon = seq(coarse_best$lon - 1, coarse_best$lon + 1, by = fine_res)
  )
  fine_grid$score <- mapply(score_point, fine_grid$lat, fine_grid$lon)
  best <- fine_grid[which.min(fine_grid$score), ]
  
  cat(sprintf("\n>>> Estimated  locations:\n"))
  cat(sprintf("    Latitude  : %.4f°\n", best$lat))
  cat(sprintf("    Longitude : %.4f°\n", best$lon))
  cat(sprintf("    Max error : ±%.1f km\n", best$score))
  cat(sprintf("    Google Maps: https://www.google.com/maps?q=%.4f,%.4f\n", best$lat, best$lon))
  
  cat(sprintf("\nStep 5: Nearby cities (within %d km, pop > %s)...\n",
              nearby_radius, format(nearby_min_pop, big.mark = ",")))
  
  world_cities <- world.cities
  nearby <- world_cities |>
    filter(pop > nearby_min_pop) |>
    mutate(
      dist_to_sign = distHaversine(
        cbind(long, lat),
        c(best$lon, best$lat)
      ) / 1000
    ) |>
    filter(dist_to_sign <= nearby_radius) |>
    arrange(dist_to_sign) |>
    select(name, country.etc, lat, long, pop, dist_to_sign) |>
    head(10)
  
  if (nrow(nearby) > 0) {
    cat("\n  Cities found:\n")
    print(nearby, digits = 4)
    cat(sprintf("\n  Nearest: %s, %s (%.1f km away)\n",
                nearby$name[1], nearby$country.etc[1], nearby$dist_to_sign[1]))
  } else {
    cat("No major locations found in vicinity!")
  }
  

}

So now, that we understand the useless problem, we can put this to the test

# sample 2 - real with correct distances calculater from#  https://www.distancefromto.net/  "air distance"# result must be Ljubljana, Sloveniaresult <- sign_location_finder(  cities    = c("Koper", "Celje", "Maribor", "Kranj"),  distances = c(83, 61, 104, 24),  tolerance = 20) 

In this case I have entered the correct air distances and there should be a location present – which is capital of Slovenia – Ljubljana.

I have inserted the real values of air distances between Ljubljana all all four cities: Koper, Celje, Maribor, Kranj using air distance calculator.

And this where the circles should meet

So if you are enjoying your vacation and you stumble upon a sign, check it and let me know, if it corresponds to your location of not

As always, the complete code is available on GitHub in  Useless_R_function repository and the file Honest_geographical_location_signposts.R is here.

Check the repository for future updates!

Stay healthy, hydrated and happy R-coding!