Upload 2 files

depth_interactive_map_alpha.R

@@ -92,17 +92,26 @@ ENVIPE_PAL <- c("#fef0d9", "#fdcc8a", "#fc8d59", "#e34a33",
                 "#b30000", "#7f0000")                             # OrRd 6
 
 # GIIM keys MUST match the Spanish category strings stored in
-# dim_remesas_mun.giim_mun (Muy bajo / Bajo / Medio / Alto / Muy alto) so the
-# MapLibre `match` paint expression actually pairs each muni with a colour.
-# "No aplica" and "Nulo" are intentionally absent here -- they paint via the
-# match-fallback to fully-transparent and are filtered out of the legend.
+# dim_remesas_mun.giim_mun so the MapLibre `match` paint expression pairs
+# each muni with a colour. The legend displays English via GIIM_LABELS_EN.
+# "No aplica" is intentionally absent -- it paints via match-fallback to
+# fully transparent and is excluded from the legend.
 GIIM_COLORS <- c(
+  "Nulo"     = "#94a3b8",   # slate-grey (no remittance flow)
   "Muy bajo" = "#dbeafe",
   "Bajo"     = "#93c5fd",
   "Medio"    = "#3b82f6",
   "Alto"     = "#1d4ed8",
   "Muy alto" = "#1e3a8a"
 )
+GIIM_LABELS_EN <- c(
+  "Nulo"     = "Null",
+  "Muy bajo" = "Very low",
+  "Bajo"     = "Low",
+  "Medio"    = "Medium",
+  "Alto"     = "High",
+  "Muy alto" = "Very High"
+)
 
 MIGRANTS_PAL <- c("#ffffb2", "#fecc5c", "#fd8d3c",
                   "#f03b20", "#bd0026", "#800026")                # YlOrRd 6
@@ -149,6 +158,34 @@ PATP_DELITO_PAL <- c(
   "Libertad personal"                  = "#6a3d9a"
 )
 
+# Spanish-key -> English-display maps used by acc_legend_cats() so that the
+# data keeps matching MapLibre paint expressions (in Spanish, as stored in
+# the database) while the legend reads in English. Keyed by palette name
+# (giim / patp_rural / patp_delito) -- LEGEND_LABEL_MAPS[[pal_name]] is
+# threaded through acc_legend_from_spec().
+PATP_RURAL_LABELS_EN <- c(
+  "Sociales y económicos"                                              = "Social and economic",
+  "Carencia o deficiencia en servicios básicos"                        = "Lack / deficient basic services",
+  "Caminos, transportes y telecomunicaciones"                          = "Roads, transport and telecom",
+  "Inseguridad, delincuencia y adicciones"                             = "Insecurity, crime and addictions",
+  "Carencia o deficiencia en la infraestructura educativa y de salud"  = "Lack / deficient education and health infrastructure",
+  "Municipios sin localidades objetivo"                                = "Municipalities without target localities",
+  "Sin problema"                                                       = "No problem",
+  "Falta de información / Otro problema"                               = "Missing information / other",
+  "Riesgos ambientales"                                                = "Environmental risk",
+  "Problema no definido"                                               = "Undefined problem"
+)
+PATP_DELITO_LABELS_EN <- c(
+  "El patrimonio"                      = "Property",
+  "otros bienes"                       = "Other property",
+  "La vida y la Integridad corporal"   = "Life and bodily integrity",
+  "múltiples bienes"                   = "Multiple assets",
+  "La familia"                         = "Family",
+  "Sin delito"                         = "No crime",
+  "La libertad y la seguridad sexual"  = "Sexual freedom and safety",
+  "Libertad personal"                  = "Personal freedom"
+)
+
 # Infrastructure point categories -- grouped from the raw "category" field
 # (Shelter / restaurant / Government / lodging / Legal/NGO / Food / charity /
 #  police / hospital / Religious / embassy / Medical / place-of-worship)
@@ -227,6 +264,14 @@ POP_COLS <- list(
 
 # PATP sub-types (kind controls paint family: "num" = step, "cat" = match).
 PATP_COLS <- list(
+  # Poverty chips come first -- the user reads PATP-CONEVAL primarily as a
+  # poverty layer, so the default chip + the most-used variants are at the top.
+  "pobreza_pct"      = list(col = "pobreza_pct",     kind = "num",
+                            label = "Poverty (%)",
+                            breaks = c(20, 35, 50, 65, 80, 90)),
+  "pobreza_ext_pct"  = list(col = "pobreza_ext_pct", kind = "num",
+                            label = "Extreme poverty (%)",
+                            breaks = c(2, 5, 10, 20, 35, 55)),
   "t_part"     = list(col = "t_part",     kind = "num", label = "Economic participation rate",
                       breaks = c(35, 45, 50, 55, 60, 70)),
   "t_ocup"     = list(col = "t_ocup",     kind = "num", label = "Occupation rate",
@@ -480,9 +525,14 @@ WEB_SQL_TEMPLATES <- list(
             CAST(p.ind_conec  AS DOUBLE) AS ind_conec,
             p.pr_pred_loc_rur,
             p.delitos_fc_b_j_a,
+            -- Joined-in CONEVAL poverty columns so the same patp-choro layer
+            -- can paint by poverty / extreme-poverty without a second source.
+            CAST(pob.pobreza_pct     AS DOUBLE) AS pobreza_pct,
+            CAST(pob.pobreza_ext_pct AS DOUBLE) AS pobreza_ext_pct,
             c.wkt
      FROM crime_mun c
-     LEFT JOIN dim_patp_mun p ON c.CVEGEO = p.CVEGEO",
+     LEFT JOIN dim_patp_mun     p   ON c.CVEGEO = p.CVEGEO
+     LEFT JOIN dim_pobreza_mun  pob ON c.CVEGEO = pob.CVEGEO",
 
   src_pobreza =
     "SELECT c.municipio, c.entidad, c.CVEGEO,
@@ -1023,6 +1073,17 @@ WEB_SPEC <- list(
     patp_delito = PATP_DELITO_PAL
   ),
 
+  # Palettes whose keys are Spanish (because that's what the database stores)
+  # but whose legends should display English. acc_legend_from_spec() looks up
+  # the active palette name here and passes the matching map to
+  # acc_legend_cats() so the visible label is English while the data-cat
+  # attribute (used by the filter + the MapLibre `match`) stays Spanish.
+  legend_label_maps = list(
+    giim        = GIIM_LABELS_EN,
+    patp_rural  = PATP_RURAL_LABELS_EN,
+    patp_delito = PATP_DELITO_LABELS_EN
+  ),
+
   crime_cols   = CRIME_COLS,
   fosas_cols   = FOSAS_COLS,
   envipe_cols  = ENVIPE_COLS,
@@ -1185,7 +1246,7 @@ WEB_SPEC <- list(
            )),
       list(kind = "radios", group = "patp"),
       list(kind = "layer", value = "pobreza-choro",
-           label = "Poverty (CONEVAL 2020)",
+           label = "Poverty",
            tooltip = "CONEVAL 2020 poverty / extreme poverty share by municipality. Enable the grid view to see this layer.",
            legend = list(type = "ramp", pal = "pobreza", unit = " %",
                          labels = "qualitative")),
@@ -1215,10 +1276,12 @@ WEB_SPEC <- list(
       list(label = "Recent resident (abroad in 2015)",  value = "PRESOP2015")
     ),
     patp = list(
-      list(label = "Economic Participation rate",          value = "t_part"),
+      list(label = "Poverty (%)",                 value = "pobreza_pct"),
+      list(label = "Extreme poverty (%)",         value = "pobreza_ext_pct"),
+      list(label = "Economic participation rate", value = "t_part"),
       list(label = "Occupation rate",             value = "t_ocup"),
-      list(label = "PR indicator",                value = "pr"),
-      list(label = "connectivity index",          value = "ind_conec"),
+      list(label = "Remittance receipt per capita", value = "pr"),
+      list(label = "Road connectivity index",     value = "ind_conec"),
       list(label = "Predominant rural problem",   value = "pr_pred_loc_rur"),
       list(label = "Common-jurisdiction crime",   value = "delitos_fc_b_j_a")
     ),
@@ -1330,7 +1393,7 @@ LUCIDE_JS <- tags$head(
           Shiny.setInputValue('envipe_type', 'insecurity',    { priority: 'event' });
           Shiny.setInputValue('fosas_type',  'fosas',         { priority: 'event' });
           Shiny.setInputValue('pop_type',    'POBTOT',        { priority: 'event' });
-          Shiny.setInputValue('patp_type',   't_part',        { priority: 'event' });
+          Shiny.setInputValue('patp_type',   'pobreza_pct',   { priority: 'event' });
           Shiny.setInputValue('pobreza_type','pobreza_pct',   { priority: 'event' });
           Shiny.setInputValue('grid_nivel',  '6',             { priority: 'event' });
         }, 300);
@@ -1785,7 +1848,8 @@ LUCIDE_JS <- tags$head(
     // by setPATPType / setPobrezaType after they update window state, and
     // also by updateActiveLayers when the layer toggle flips.
     var _activeVariants = { patp: 'numeric', pobreza: 'numeric' };
-    var PATP_NUMERIC    = ['t_part','t_ocup','pr','ind_conec'];
+    var PATP_NUMERIC    = ['pobreza_pct','pobreza_ext_pct',
+                           't_part','t_ocup','pr','ind_conec'];
     var POBREZA_NUMERIC = ['pobreza_pct','pobreza_ext_pct'];
 
     function _variantKeyFor(group, type) {
@@ -2336,28 +2400,38 @@ acc_legend_ramp <- function(pal, lo = "Low", hi = "High") {
   ))
 }
 
-acc_legend_cats <- function(cats, filterable_key = NULL) {
+acc_legend_cats <- function(cats, filterable_key = NULL, label_map = NULL) {
+  # `label_map` (optional) maps each palette key to a different DISPLAY label.
+  # The data attribute (`data-cat`) keeps the palette key so the MapLibre
+  # paint expression and the filter both match what's in the database; only
+  # the visible text changes. Used to render Spanish-keyed palettes (GIIM,
+  # PATP rural / crime) with English legend labels.
+  display_for <- function(nm) {
+    if (!is.null(label_map) && nm %in% names(label_map)) unname(label_map[nm])
+    else nm
+  }
   is_filter <- !is.null(filterable_key) && nzchar(filterable_key)
   items <- paste(vapply(seq_along(cats), function(i) {
     nm  <- names(cats)[i]
     col <- unname(cats[i])
+    disp <- display_for(nm)
     if (is_filter) {
       paste0(
         '<button type="button" class="acc-legend-cat acc-legend-cat--filter is-on"',
         ' data-filter-layer="', filterable_key, '"',
         ' data-cat="', htmltools::htmlEscape(nm, attribute = TRUE), '"',
         ' aria-pressed="true"',
-        ' aria-label="Toggle category ', htmltools::htmlEscape(nm, attribute = TRUE), '"',
+        ' aria-label="Toggle category ', htmltools::htmlEscape(disp, attribute = TRUE), '"',
         ' onclick="toggleLegendFilter(this)">',
         '<span class="acc-legend-swatch" style="background:', col, '"></span>',
-        '<span class="acc-legend-cat-label">', htmltools::htmlEscape(nm), '</span>',
+        '<span class="acc-legend-cat-label">', htmltools::htmlEscape(disp), '</span>',
         '</button>'
       )
     } else {
       paste0(
         '<div class="acc-legend-cat">',
         '<span class="acc-legend-swatch" style="background:', col, '"></span>',
-        '<span>', htmltools::htmlEscape(nm), '</span>',
+        '<span>', htmltools::htmlEscape(disp), '</span>',
         '</div>'
       )
     }
@@ -2547,7 +2621,8 @@ acc_legend_from_spec <- function(lg) {
                         hi = lg$hi %||% bnds$hi)
       }
     },
-    cats = acc_legend_cats(pal, filterable_key = lg$filterable),
+    cats = acc_legend_cats(pal, filterable_key = lg$filterable,
+                            label_map = WEB_SPEC$legend_label_maps[[lg$pal]]),
     dot  = acc_legend_dot(lg$color, lg$label %||% "Event / point"),
     line = acc_legend_line(lg$color, lg$label %||% "Route",
                            dashed = isTRUE(lg$dashed)),
@@ -4257,7 +4332,7 @@ server <- function(input, output, session) {
         envipe_type  = input$envipe_type  %||% "insecurity",
         fosas_type   = input$fosas_type   %||% "fosas",
         pop_type     = input$pop_type     %||% "POBTOT",
-        patp_type    = input$patp_type    %||% "t_part",
+        patp_type    = input$patp_type    %||% "pobreza_pct",
         pobreza_type = input$pobreza_type %||% "pobreza_pct"
       )
     },
@@ -4545,20 +4620,34 @@ server <- function(input, output, session) {
     }
   }
 
-  treemap_plot <- function(df, pal, base_size = 7) {
+  # Compact text inside a treemap cell: short label + smaller %, sized so
+  # they actually fit a ~70px tall card slot. geom_text `size` is in mm;
+  # 2.2mm ~ 6.3pt for the label and 1.8mm ~ 5.1pt for the percentage --
+  # smaller than the surrounding card text, which is the point.
+  treemap_plot <- function(df, pal) {
     laid <- treemap_layout(df)
     if (is.null(laid)) return(NULL)
-    laid$pct <- round(100 * laid$value / sum(laid$value))
-    laid$label_full <- paste0(laid$label, "\n", laid$pct, "%")
+    total <- sum(laid$value)
+    laid$pct  <- round(100 * laid$value / total)
+    laid$cx   <- (laid$xmin + laid$xmax) / 2
+    laid$cy   <- (laid$ymin + laid$ymax) / 2
+    laid$w    <- laid$xmax - laid$xmin
+    # Truncate long labels so they don't crash the cell border. ~13 chars
+    # fits a half-row at the card width; less for narrow cells.
+    max_chars <- pmax(6L, pmin(20L, as.integer(laid$w * 26)))
+    short <- ifelse(nchar(laid$label) > max_chars,
+                    paste0(substr(laid$label, 1L, max_chars - 1L), "."),
+                    laid$label)
+    laid$short <- short
     ggplot(laid, aes(xmin = xmin, xmax = xmax,
                      ymin = ymin, ymax = ymax,
                      fill = label)) +
       geom_rect(color = "#0f172a", linewidth = 0.4) +
-      geom_text(aes(x = (xmin + xmax) / 2,
-                    y = (ymin + ymax) / 2,
-                    label = label_full),
-                size = base_size / .pt * 2.4, color = "white",
-                fontface = "bold", lineheight = 0.85) +
+      geom_text(aes(x = cx, y = cy + 0.10, label = short),
+                size = 2.2, color = "white",
+                fontface = "bold", lineheight = 0.9) +
+      geom_text(aes(x = cx, y = cy - 0.18, label = paste0(pct, "%")),
+                size = 1.9, color = "white", alpha = 0.85) +
       scale_fill_manual(values = pal, na.value = "#334155") +
       coord_cartesian(expand = FALSE, xlim = c(0, 1), ylim = c(0, 1)) +
       theme_void() +
@@ -4598,7 +4687,7 @@ server <- function(input, output, session) {
                               value = agg$n_dead,
                               color = unname(CAUSE_PAL[agg$cause_cat]),
                               stringsAsFactors = FALSE)
-    treemap_plot(summary_df, CAUSE_PAL, base_size = 8)
+    treemap_plot(summary_df, CAUSE_PAL)
   }, bg = "transparent", res = 110)
 
   output$migrants_treemap_demo <- renderPlot({
@@ -4612,7 +4701,7 @@ server <- function(input, output, session) {
       color = unname(DEMO_PAL),
       stringsAsFactors = FALSE
     )
-    treemap_plot(summary_df, DEMO_PAL, base_size = 8)
+    treemap_plot(summary_df, DEMO_PAL)
   }, bg = "transparent", res = 110)
 
   # Shared helper: temporal bar chart by year for point event tables

styles.css

@@ -663,6 +663,19 @@
   padding: var(--space-1) 10px var(--space-2);
 }
 
+/* Sub-heading above an inline chart (e.g. each migrants treemap). Matches the
+   uppercase / mid-tone scale of .ind-card-title but slightly smaller so it
+   reads as a sub-section, not a peer title. */
+.ind-card-chart-label {
+  font-family: var(--font-ui);
+  font-size: 9px;
+  font-weight: 600;
+  letter-spacing: 0.07em;
+  text-transform: uppercase;
+  color: var(--c-text-mid);
+  margin-bottom: 3px;
+}
+
 .ind-card-note {
   font-size: 11px;
   color: var(--c-text-mid);