Mici funcții R inutile-utile – Indicatoare cinstite de locație geografică

Cu toții am văzut indicatoare colorate cu orașe grozave și distanțele lor – cât de departe este fiecare din acest punct de vedere actual.

Și întrebarea fundamentală este, cât de corecte sunt aceste distanțe? Sau chiar, ar trebui să se întrebe, cât de sincer este un anumit indicator, în ceea ce privește punctul de vedere actual.

Deci, să punem la încercare această întrebare fundamentală Și din moment ce este vremea vacanței, puteți lua codul R și îl verificați singur

Imaginea care a dat peste postare și a vrut să verific dacă această postare este cu adevărat relevantă pentru această locație. Poate fi o fotografie din cealaltă parte a lumii, agățată în holul hotelului tău de vacanță Și cu siguranță acesta nu este un indicator cinstit

Codul R iterează prin fiecare oraș, găsește puncte de potrivire (unde se întâlnesc toate cercurile) și caută cea mai apropiată locație. Utilizează OpenStreetMap (scurt: OSM) pentru a extrage toate geolocațiile și caută posibile intersecții ale tuturor punctelor

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 httpn")
    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 citiesn")
  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 kmn", best$score))
  cat(sprintf("    Google Maps: https://www.google.com/maps?q=%.4f,%.4fn", 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!")
  }
  

}

Așa că acum, că înțelegem problema inutilă, putem pune asta la încercare

În acest caz, am introdus distanțele aeriene corecte și ar trebui să existe o locație prezentă – care este capitala Sloveniei – Ljubljana.

Am introdus valorile reale ale distanțelor aeriene dintre Ljubljana toate cele patru orașe: Koper, Celje, Maribor, Kranj folosind calculatorul de distanță aeriană.

Și aici ar trebui să se întâlnească cercurile

Deci, dacă vă bucurați de vacanță și dați peste un semn, verificați-l și spuneți-mi dacă corespunde locației dvs. de nu

Verificați depozitul pentru actualizări viitoare!

Rămâi sănătos, hidratat și fericit cu codificarea R!