Last active
January 19, 2026 08:57
-
-
Save ar-puuk/d0180b9b943907a571897a10fae8e35d to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| if (!require("rvest")) install.packages("rvest") | |
| if (!require("xml2")) install.packages("xml2") | |
| if (!require("httr2")) install.packages("httr2") | |
| library(rvest) | |
| library(xml2) | |
| library(httr2) | |
| # 1. Dynamic Download Path | |
| # Tries to find Windows User Profile first, falls back to generic HOME | |
| user_home <- Sys.getenv("USERPROFILE") | |
| if (user_home == "") user_home <- Sys.getenv("HOME") | |
| # Construct the full path safely | |
| output_filename <- file.path(user_home, "Downloads", "nepal_live_map.svg") | |
| # 2. Setup URL | |
| url <- "https://generalelection2079.ekantipur.com/heatmap" | |
| tryCatch({ | |
| message("Fetching data...") | |
| # 3. Fetch Content | |
| req <- request(url) %>% | |
| req_user_agent("Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/115.0.0.0 Safari/537.36") | |
| resp <- req_perform(req) | |
| html_content <- resp_body_html(resp) | |
| # 4. Extract SVG | |
| svg_node <- html_element(html_content, xpath = "//svg[.//pattern[@id='np__BG']]") | |
| if (!inherits(svg_node, "xml_missing")) { | |
| # --- SIMPLIFIED VIEWBOX FIX --- | |
| # Force the 1920x1080 size directly | |
| xml_set_attr(svg_node, "viewBox", "0 0 1920 1080") | |
| # 5. Add CSS | |
| # 'overflow: visible' ensures any points below 1080 are still drawn | |
| css_styles <- " | |
| path { fill: #cccccc; stroke: #fff; cursor: pointer; stroke-width: 1.75px; } | |
| path:hover { opacity: 0.9; } | |
| .national-park { fill: #55e5a5 !important; } | |
| svg { overflow: visible !important; } | |
| " | |
| xml_add_child(svg_node, "style", css_styles, .where = 0) | |
| # 6. Save | |
| write_xml(svg_node, output_filename) | |
| message(paste("Success! Map saved to:", output_filename)) | |
| } else { | |
| warning("SVG not found.") | |
| } | |
| }, error = function(e) { | |
| message("Error fetching URL: ", e$message) | |
| }) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| if (!require("sf")) install.packages("sf") | |
| if (!require("xml2")) install.packages("xml2") | |
| if (!require("stringr")) install.packages("stringr") | |
| if (!require("dplyr")) install.packages("dplyr") | |
| library(sf) | |
| library(xml2) | |
| library(stringr) | |
| library(dplyr) | |
| # ========================================== | |
| # 1. SETUP | |
| # ========================================== | |
| user_home <- Sys.getenv("USERPROFILE") | |
| if (user_home == "") user_home <- Sys.getenv("HOME") | |
| input_svg_path <- file.path(user_home, "Downloads", "nepal_live_map.svg") | |
| output_geojson_path <- file.path(user_home, "Downloads", "nepal_map_georeferenced.geojson") | |
| if (!file.exists(input_svg_path)) stop("Input file not found!") | |
| target_bbox <- st_bbox(c(xmin = 80.04, ymin = 26.35, xmax = 88.20, ymax = 30.45), crs = 4326) | |
| # ========================================== | |
| # 2. PARSE SVG (With Robust "-" Handling) | |
| # ========================================== | |
| message("Parsing SVG paths...") | |
| doc <- read_xml(input_svg_path) | |
| path_nodes <- xml_find_all(doc, "//*[local-name()='path']") | |
| parse_d_robust <- function(d) { | |
| d_clean <- str_replace_all(d, "-", " -") | |
| d_clean <- str_replace_all(d_clean, "[a-zA-Z]", " ") | |
| nums <- as.numeric(str_split(d_clean, "[\\s,]+")[[1]]) | |
| nums <- nums[!is.na(nums)] | |
| if (length(nums) < 4) { | |
| return(NULL) | |
| } | |
| mtx <- matrix(nums, ncol = 2, byrow = TRUE) | |
| if (!all(mtx[1, ] == mtx[nrow(mtx), ])) { | |
| mtx <- rbind(mtx, mtx[1, ]) | |
| } | |
| if (nrow(mtx) < 4) { | |
| return(NULL) | |
| } | |
| return(mtx) | |
| } | |
| polys_list <- list() | |
| id_list <- character() | |
| for (i in seq_along(path_nodes)) { | |
| d_attr <- xml_attr(path_nodes[i], "d") | |
| id_val <- xml_attr(path_nodes[i], "data-slug") | |
| if (is.na(id_val)) id_val <- paste0("shape_", i) | |
| coords <- parse_d_robust(d_attr) | |
| if (!is.null(coords)) { | |
| polys_list[[length(polys_list) + 1]] <- st_polygon(list(coords)) | |
| id_list <- c(id_list, id_val) | |
| } | |
| } | |
| if (length(polys_list) == 0) stop("No valid paths found.") | |
| nepal_sf <- st_sf(name = id_list, geometry = st_sfc(polys_list)) | |
| # ========================================== | |
| # 3. TRANSFORM (Flip & Scale to WGS84) | |
| # ========================================== | |
| message("Transforming geometry...") | |
| # Flip Y | |
| flip_matrix <- matrix(c(1, 0, 0, -1), ncol = 2) | |
| nepal_sf$geometry <- nepal_sf$geometry * flip_matrix | |
| # Calculate Scale | |
| src_bbox <- st_bbox(nepal_sf) | |
| tgt_w <- target_bbox$xmax - target_bbox$xmin | |
| tgt_h <- target_bbox$ymax - target_bbox$ymin | |
| src_w <- src_bbox$xmax - src_bbox$xmin | |
| src_h <- src_bbox$ymax - src_bbox$ymin | |
| scale_x <- tgt_w / src_w | |
| scale_y <- tgt_h / src_h | |
| # Shift & Scale | |
| shift_to_zero <- c(src_bbox$xmin, src_bbox$ymin) | |
| nepal_sf$geometry <- nepal_sf$geometry - shift_to_zero | |
| scale_matrix <- matrix(c(scale_x, 0, 0, scale_y), ncol = 2) | |
| nepal_sf$geometry <- nepal_sf$geometry * scale_matrix | |
| shift_to_target <- c(target_bbox$xmin, target_bbox$ymin) | |
| nepal_sf$geometry <- nepal_sf$geometry + shift_to_target | |
| # Set initial CRS to WGS84 | |
| st_crs(nepal_sf) <- 4326 | |
| # ========================================== | |
| # 4. CLEANING (Using Projected Metric CRS) | |
| # ========================================== | |
| message("Projecting to UTM Zone 45N (Meters) for cleaning...") | |
| # A. Project to Metric System (UTM Zone 45N - EPSG:32645) | |
| # This allows us to work in Meters instead of Degrees. | |
| nepal_sf <- st_transform(nepal_sf, 32645) | |
| # B. Snap to Grid (Fix Slivers) | |
| # We set precision to 1. This means we snap coordinates to the nearest 1 METER. | |
| # (Previous 1e6 in degrees was ~10cm. 1 meter is safer for fixing slivers.) | |
| nepal_sf <- st_set_precision(nepal_sf, 1) | |
| # C. Make Valid (Fix Self-Intersections) | |
| nepal_sf <- st_make_valid(nepal_sf) | |
| # D. Buffer 0 (Merge internal topology errors) | |
| # Since we are now in meters, this calculates validity on a flat plane. | |
| # Note: If you still see slivers, change '0' to '50' (50 meters expansion). | |
| nepal_sf <- st_buffer(nepal_sf, 0) | |
| # E. Transform back to WGS84 (Lat/Long) for final GeoJSON | |
| message("Transforming back to WGS84...") | |
| nepal_sf <- st_transform(nepal_sf, 4326) | |
| # ========================================== | |
| # 5. SAVE | |
| # ========================================== | |
| st_write(nepal_sf, output_geojson_path, driver = "GeoJSON", delete_dsn = TRUE, quiet = TRUE) | |
| message("Success! Cleaned GeoJSON saved to:") | |
| message(output_geojson_path) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment