library(sf)

## Linking to GEOS 3.13.1, GDAL 3.10.2, PROJ 9.5.1; sf_use_s2() is TRUE

library(dplyr)

## 
## Присоединяю пакет: 'dplyr'

## Следующие объекты скрыты от 'package:stats':
## 
##     filter, lag

## Следующие объекты скрыты от 'package:base':
## 
##     intersect, setdiff, setequal, union

library(readxl)
library(leaflet)

## Warning: пакет 'leaflet' был собран под R версии 4.5.1

library(scales)
library(rmapshaper)

## Warning: пакет 'rmapshaper' был собран под R версии 4.5.1

library(htmltools)

sf::sf_use_s2(FALSE)

## Spherical geometry (s2) switched off

knitr::opts_chunk$set(message = FALSE, warning = FALSE)

library(sf)
library(dplyr)
library(readxl)
library(leaflet)
library(scales)
library(rmapshaper)
library(htmltools)

sf::sf_use_s2(FALSE)
knitr::opts_chunk$set(message = FALSE, warning = FALSE)

# Пути к данным (оставлены как у тебя)

gpkg_path  <- "G:/Мой диск/ВКР/R_data/Сбериндекс/t_dict_municipal_districts_poly.gpkg"
gpkg_layer <- "t_dict_municipal_districts_poly"
xlsx_path  <- "./analysis_df4.xlsx"

# Геометрия МО

g <- st_read(gpkg_path, layer = gpkg_layer, quiet = TRUE) |>
mutate(territory_id = as.character(territory_id)) |>
dplyr::select(territory_id, dplyr::everything()) |>
st_transform(4326) |>
st_make_valid() |>
rmapshaper::ms_simplify(keep = 0.05, keep_shapes = TRUE)

# Показатели

df <- read_excel(xlsx_path) |>
mutate(
territory_id            = as.character(territory_id),
pickup_per_100k         = as.numeric(pickup_per_100k),
salary                  = as.numeric(salary),
avg_age                 = as.numeric(avg_age),
rural_population_share  = as.numeric(rural_population_share),
urbanization            = pmax(pmin(1 - rural_population_share, 1), 0)
) |>
dplyr::select(
territory_id, region, municipal_district_name,
pickup_per_100k, salary, avg_age, urbanization
)

# Соединяем

dat <- g |> left_join(df, by = "territory_id")

# Попапы

nm <- ifelse(is.na(dat$municipal_district_name), "(неизвестно)", dat$municipal_district_name)
rg <- ifelse(is.na(dat$region), "", dat$region)
popup <- sprintf(
"<b>%s</b><br/>%s<hr style='margin:4px 0;'/>
ПВЗ на 100 тыс.: <b>%s</b><br/>
Зарплата: <b>%s ₽</b><br/>
Возраст: <b>%s</b><br/>
Урбанизация: <b>%s%%</b>",
nm, rg,
number(dat$pickup_per_100k, accuracy = 0.1),
number(dat$salary, accuracy = 1, big.mark = " "),
number(dat$avg_age, accuracy = 0.1),
number(100 * dat$urbanization, accuracy = 0.1)
)

# ---------- НОРМАЛИЗАЦИЯ ПРЕДИКТОРОВ ----------
z <- function(x) (x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
dat$salary_z <- z(dat$salary)
dat$age_z    <- z(dat$avg_age)
dat$urb_z    <- z(dat$urbanization)

# ---------- Цвета ----------
na_col <- "#F2E2B5"  # бежевый для NA (чётко отличается от серой «середины»)
brks   <- c(-Inf, -1.5, -0.5, 0.5, 1.5, Inf)
pal    <- colorBin(
  palette  = rev(RColorBrewer::brewer.pal(5, "RdBu")),
  domain   = c(-3, 3),
  bins     = brks,
  na.color = na_col
)

# дружелюбные подписи к границам легенды
lab_sigma <- function(type, cuts, p) {
  b <- cuts; n <- length(b); out <- character(n - 1)
  for (i in seq_len(n - 1)) {
    L <- b[i]; R <- b[i + 1]
    if (is.infinite(L))         out[i] <- "≤ −1.5σ (ниже)"
    else if (is.infinite(R))    out[i] <- "≥ +1.5σ (выше)"
    else if (L == -0.5 && R == 0.5) out[i] <- "средний уровень (±0.5σ)"
    else out[i] <- paste0(ifelse(L > 0, paste0("+", L), L), "σ … ",
                          ifelse(R > 0, paste0("+", R), R), "σ")
  }
  out
}

# ---------- Кружки ПВЗ ----------
pts <- sf::st_point_on_surface(dat)
rad <- function(v) scales::rescale(sqrt(pmax(v, 0)), to = c(3, 18))

# Легенда размеров (Q1/медиана/90-й перц.) + пояснение
qv <- quantile(dat$pickup_per_100k, c(.25, .5, .9), na.rm = TRUE)
qs <- rad(qv)
size_leg <- paste0(
  "<div style='background:rgba(255,255,255,0.95);padding:8px 10px;border:1px solid #e5e7eb;border-radius:8px;font-size:12px;'>",
  "<div style='font-weight:600;margin-bottom:4px;'>Размер кружка: ПВЗ на 100 тыс.</div>",
  "<div style='display:flex;gap:12px;align-items:flex-end;'>",
  paste0(
    vapply(seq_along(qv), function(i) {
      d <- round(qv[i], 1); s <- round(qs[i])
      sprintf(
        "<div style='text-align:center;'>
           <div style='width:%dpx;height:%dpx;border-radius:50%%;border:1px solid #333;background:#1111;margin:0 auto;'></div>
           <div style='font-size:11px;margin-top:2px;'>≈ %s</div>
         </div>",
        s * 2, s * 2, d
      )
    }, character(1L)), collapse = ""
  ),
  "<div style='font-size:11px;color:#666;margin-top:6px;'>Опорные значения по всем муниципалитетам РФ</div>",
  "</div>"
)

# краткая подсказка (что такое цвет и z-баллы)
help_box <- paste0(
  "<div style='background:rgba(255,255,255,0.95);padding:8px 10px;border:1px solid #e5e7eb;border-radius:8px;font-size:12px;max-width:380px;'>",
  "<b>Как читать карту</b><br/>",
  "Цвет полигона — отклонение выбранного предиктора от среднего по всем муниципалитетам (z-баллы). ",
  "Красный — выше среднего, серый — около среднего, синий — ниже. ",
  "Бежевый цвет означает, что данных нет. ",
  "Размер серых кружков — ПВЗ на 100 тыс. жителей.",
  "</div>"
)

# ---------- КАРТА ----------
m <- leaflet(options = leafletOptions(minZoom = 3, maxZoom = 12)) |>
  addProviderTiles(providers$CartoDB.Positron, group = "Светлая подложка") |>
  addProviderTiles(providers$CartoDB.DarkMatter, group = "Тёмная подложка") |>

  addPolygons(
    data = dat, group = "Зарплата",
    fillColor = pal(dat$salary_z),
    color = "#777", weight = 0.4, fillOpacity = 0.9,
    popup = popup,
    highlightOptions = highlightOptions(weight = 2, color = "#000", bringToFront = TRUE)
  ) |>
  addPolygons(
    data = dat, group = "Возраст",
    fillColor = pal(dat$age_z),
    color = "#777", weight = 0.4, fillOpacity = 0.9,
    popup = popup
  ) |>
  addPolygons(
    data = dat, group = "Урбанизация",
    fillColor = pal(dat$urb_z),
    color = "#777", weight = 0.4, fillOpacity = 0.9,
    popup = popup
  ) |>

  addCircleMarkers(
    data = pts, group = "ПВЗ (кружки)",
    radius = rad(pts$pickup_per_100k),
    stroke = TRUE, weight = 0.8, color = "#ffffff",
    fillColor = "#333333", fillOpacity = 0.30
  ) |>

  addLayersControl(
    baseGroups    = c("Светлая подложка", "Тёмная подложка"),
    overlayGroups = c("Зарплата", "Возраст", "Урбанизация", "ПВЗ (кружки)"),
    options = layersControlOptions(collapsed = FALSE)
  ) |>

  # единая цветовая легенда + понятная подпись
  addLegend(
    position = "bottomleft", pal = pal, values = c(-3, 3),
    title = HTML("Цвет: отклонение предиктора от среднего (z)<br/>
                 <span style='font-size:11px;'>Красный — выше среднего • Серый — около среднего • Синий — ниже среднего</span>"),
    labFormat = lab_sigma, opacity = 0.95
  ) |>

  # отдельная отметка «Нет данных» (бежевый)
  addLegend(
    position = "bottomleft",
    colors = na_col, labels = "Нет данных", opacity = 1
  ) |>

  addControl(html = HTML(size_leg), position = "bottomright") |>
  addControl(html = HTML(help_box), position = "topleft") |>

  hideGroup(c("Возраст", "Урбанизация"))

m

htmlwidgets::saveWidget(
  widget = m,                          # имя объекта карты
  file = "pvz_map_final.html",         # имя файла (можно указать путь)
  selfcontained = TRUE                 # включает все ресурсы внутрь HTML
)