Ranked Choice Voting in the 2025 Santa Fe Mayoral Race

# Reshape data from wide to long format
# Each row represents a candidate's vote count in a specific round
vote_cols <- grep("^round\\d+_votes$", names(rcv_data), value = TRUE)
transfer_cols <- grep("^round\\d+_transfer$", names(rcv_data), value = TRUE)

rcv_long <- rcv_data |>
  select(candidate, all_of(vote_cols), all_of(transfer_cols)) |>
  tidyr::pivot_longer(
    cols = all_of(c(vote_cols, transfer_cols)),
    names_to = c("round", ".value"),
    names_pattern = "round(\\d+)_(.*)"
  ) |>
  mutate(round = as.numeric(round)) |>
  arrange(candidate, round)

max_round <- max(rcv_long$round, na.rm = TRUE)

# Order candidates by Round 1 votes for consistent visualization
candidate_order <- rcv_data |>
  select(candidate, round1_votes) |>
  arrange(desc(round1_votes)) |>
  pull(candidate)

# Display reshaped data
DT::datatable(
  rcv_long,
  caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    'Reshaped Data: Long format with one row per candidate per round'
  ),
  options = list(
    scrollX = TRUE,
    pageLength = 10,
    dom = 'Brtip',
    searching = FALSE
  ),
  rownames = FALSE
)

# Initialize links data frame
all_links <- data.frame(
  source = character(),
  target = character(),
  value = numeric(),
  stringsAsFactors = FALSE
)

# Build links for each round transition
for (r in 1:(max_round - 1)) {
  curr <- rcv_long |> filter(round == r)
  next_r <- rcv_long |> filter(round == r + 1)
  
  # Compare votes between rounds to identify changes
  vote_compare <- curr |>
    select(candidate, votes_curr = votes) |>
    inner_join(next_r |> select(candidate, votes_next = votes), by = "candidate")
  
  # Identify eliminated candidates (had votes, now have zero)
  eliminated <- vote_compare |>
    filter(votes_curr > 0 & votes_next == 0) |>
    pull(candidate)
  
  # Identify surviving candidates
  survivors <- next_r |> filter(votes > 0) |> pull(candidate)
  
  # Create links for candidates who maintained votes
  for (cand in survivors) {
    v_curr <- curr |> filter(candidate == cand) |> pull(votes)
    if (!is.na(v_curr) && v_curr > 0) {
      all_links <- rbind(all_links, data.frame(
        source = paste0(cand, "_R", r),
        target = paste0(cand, "_R", r + 1),
        value = v_curr,
        stringsAsFactors = FALSE
      ))
    }
  }
  
  # Create links for vote transfers from eliminated candidates
  if (length(eliminated) == 0) next
  
  # Calculate net vote gains for remaining candidates
  next_with_curr <- vote_compare |>
    mutate(net_gain = votes_next - votes_curr)
  
  gainers <- next_with_curr |> filter(net_gain > 0) |> pull(candidate)
  total_gain <- sum(next_with_curr$net_gain[next_with_curr$net_gain > 0])
  if (total_gain <= 0) next
  
  # Distribute eliminated candidate's votes proportionally to gainers
  for (loser in eliminated) {
    loser_votes <- curr |> filter(candidate == loser) |> pull(votes)
    if (is.na(loser_votes)) next
    for (winner in gainers) {
      winner_gain <- next_with_curr |> filter(candidate == winner) |> pull(net_gain)
      value <- round(loser_votes * (winner_gain / total_gain))
      if (value > 0) {
        all_links <- rbind(all_links, data.frame(
          source = paste0(loser, "_R", r),
          target = paste0(winner, "_R", r + 1),
          value = value,
          stringsAsFactors = FALSE
        ))
      }
    }
  }
}

if (nrow(all_links) == 0) stop("No links!")

# Display vote transfer links
DT::datatable(
  all_links,
  caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    'Vote Transfer Links: Source (candidate_round) to Target with vote counts'
  ),
  options = list(
    scrollX = TRUE,
    pageLength = 10,
    dom = 'Brtip',
    searching = FALSE
  ),
  rownames = FALSE
)

# Extract unique nodes from links
all_nodes <- sort(unique(c(all_links$source, all_links$target)))
candidate_rank <- setNames(seq_along(candidate_order) - 1, candidate_order)

# Create nodes data frame with ordering
nodes_df <- tibble(name = all_nodes) |>
  mutate(
    candidate = gsub("_R\\d+$", "", name),
    round_num = as.numeric(gsub(".*_R(\\d+)", "\\1", name)),
    rank = candidate_rank[candidate]
  ) |>
  arrange(rank, round_num) |>
  mutate(node_index = row_number() - 1)

# Add vote counts to nodes
nodes_df <- nodes_df |>
  left_join(
    rcv_long |> select(candidate, round, votes),
    by = c("candidate" = "candidate", "round_num" = "round")
  )

# Helper function to extract last name for labels
get_last_name <- function(full_name) {
  parts <- trimws(unlist(strsplit(full_name, " ")))
  parts <- parts[parts != ""]
  if (length(parts) == 0) return("UNKNOWN")
  toupper(parts[length(parts)])
}

# Add last names for tooltips
nodes_df <- nodes_df |>
  mutate(
    last_name = sapply(candidate, get_last_name)
    )

# Map link source/target names to node indices
links_df <- all_links |>
  mutate(
    IDsource = nodes_df$node_index[match(source, nodes_df$name)],
    IDtarget = nodes_df$node_index[match(target, nodes_df$name)]
  )

if (any(is.na(links_df$IDsource)) || any(is.na(links_df$IDtarget))) {
  stop("Node/link mismatch")
}

# Display nodes data
DT::datatable(
  nodes_df |> select(name, candidate, round_num, votes, last_name),
  caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    'Nodes Data: Each candidate at each round with vote counts'
  ),
  options = list(
    scrollX = TRUE,
    pageLength = 10,
    dom = 'Brtip',
    searching = FALSE
  ),
  rownames = FALSE
)

# Display links with mapped IDs
DT::datatable(
  links_df |> select(source, target, value, IDsource, IDtarget),
  caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    'Links with Mapped IDs: Source and target node indices for Sankey diagram'
  ),
  options = list(
    scrollX = TRUE,
    pageLength = 10,
    dom = 'Brtip',
    searching = FALSE
  ),
  rownames = FALSE
)

# Create JavaScript color scale matching candidate order
color_domain <- paste0('"', candidate_order, '"', collapse = ",")
color_range <- paste0('"', candidate_colors[candidate_order], '"', collapse = ",")
color_scale_js <- paste0("d3.scaleOrdinal().domain([", color_domain, "]).range([", color_range, "])")

# Plot with colors - set initial large width, will be resized by JavaScript
p <- networkD3::sankeyNetwork(
  Links = links_df,
  Nodes = nodes_df,
  Source = "IDsource",
  Target = "IDtarget",
  Value = "value",
  NodeID = "name",
  NodeGroup = "candidate",
  colourScale = htmlwidgets::JS(color_scale_js),
  sinksRight = TRUE,
  iterations = 0,
  fontSize = 12,
  nodeWidth = 25,
  width = 1200,
  height = 600
)

# Clean labels and make fully responsive
p <- htmlwidgets::onRender(p, '
function(el, x) {
  // Clean labels
  d3.select(el).selectAll(".node text").text(function(d) {
    if (d.name.endsWith("_R1")) {
      var name = d.name.replace(/_R1$/, "");
      var parts = name.trim().split(" ");
      return parts[parts.length - 1].toUpperCase();
    }
    return "";
  });
  
  // Get container and SVG - set to 100% immediately
  var container = el.closest(".html-widget-container") || el.parentElement;
  if (container) {
    container.style.width = "100%";
    container.style.maxWidth = "100%";
  }
  el.style.width = "100%";
  
  var svg = d3.select(el).select("svg");
  if (svg.empty()) return;
  
  // Function to update size - use 100% of container
  function updateSize() {
    // Get the width of the post content container
    var postContent = document.querySelector(".post-content") || 
                     document.querySelector(".container") ||
                     document.querySelector(".site-main") ||
                     document.body;
    var containerWidth = postContent.offsetWidth || window.innerWidth;
    
    // Also check the html-widget-container directly
    if (container && container.offsetWidth > 0) {
      containerWidth = Math.max(containerWidth, container.offsetWidth);
    }
    
    if (containerWidth > 0) {
      // Get aspect ratio from current SVG or use default
      var currentWidth = parseInt(svg.attr("width")) || containerWidth;
      var currentHeight = parseInt(svg.attr("height")) || 500;
      var aspectRatio = currentHeight / currentWidth;
      
      // Use full container width
      var newWidth = containerWidth;
      var newHeight = newWidth * aspectRatio;
      
      svg.attr("width", newWidth)
         .attr("height", newHeight);
      
      // Update the widget element size
      el.style.width = "100%";
      el.style.height = newHeight + "px";
    }
  }
  
  // Initial size update
  setTimeout(updateSize, 100);
  
  // Use ResizeObserver for better resize detection
  if (window.ResizeObserver) {
    var targetContainer = container || el.parentElement || document.body;
    var resizeObserver = new ResizeObserver(function(entries) {
      updateSize();
    });
    resizeObserver.observe(targetContainer);
  } else {
    // Fallback to window resize
    var resizeTimer;
    window.addEventListener("resize", function() {
      clearTimeout(resizeTimer);
      resizeTimer = setTimeout(updateSize, 100);
    });
  }
}
')
p