在R中实现笔友配对：循环剔除已配对人员的方案求助

Hey Anna, nice work getting your compatibility scores and ranked match lists ready—you’re already halfway there! Let’s solve this pairing problem so everyone gets a pen pal from their top 8 picks, with no repeats and the best possible overall compatibility.

We’ve got two solid approaches here: a greedy priority-based method (easy to implement and aligns with your "most picky first" sorting) and a global optimal method (uses graph theory to maximize total compatibility).

1. Greedy Priority Method (Aligns with Your Picky-First Sort) #

This method prioritizes the most selective users first (the ones you sorted by lowest best-match score), ensuring they get their top available pick before moving to less picky users.

Step-by-Step Implementation #

First, let’s clean up your data into a usable long format:

library(tidyverse)

# Assume your raw data is stored in a data frame called `raw_match_data`
cleaned_data <- raw_match_data %>%
  # Rename columns for clarity
  rename(user_id = indexed_fake, best_score = apply.fin_fake..1..max.) %>%
  # Convert wide X1-X8 columns to long format (user, match rank, candidate ID)
  pivot_longer(cols = starts_with("X"), 
               names_to = "match_rank", 
               values_to = "candidate_id") %>%
  # Convert rank to integer (1-8)
  mutate(match_rank = as.integer(str_remove(match_rank, "X"))) %>%
  # Sort by your picky-first order (lowest best_score first)
  arrange(best_score, user_id, match_rank)

Now run the greedy pairing loop:

# Initialize a data frame to track paired users
paired_users <- tibble(user_id = integer(), paired_with = integer())

# Get the priority list of users (most picky first)
priority_list <- cleaned_data %>%
  distinct(user_id, best_score) %>%
  arrange(best_score) %>%
  pull(user_id)

# Loop through each user in priority order
for (current_user in priority_list) {
  # Skip if user is already paired
  if (current_user %in% paired_users$user_id) next
  
  # Get the user's top 8 candidates, excluding anyone already paired
  available_candidates <- cleaned_data %>%
    filter(user_id == current_user) %>%
    pull(candidate_id) %>%
    setdiff(c(paired_users$user_id, paired_users$paired_with))
  
  # If there's an available candidate, pair them
  if (length(available_candidates) > 0) {
    top_available <- available_candidates[1]
    # Add both directions to the paired list
    paired_users <- paired_users %>%
      add_row(user_id = current_user, paired_with = top_available) %>%
      add_row(user_id = top_available, paired_with = current_user)
  }
}

# View final unique pairs (remove duplicate entries)
final_pairs <- paired_users %>%
  distinct(user_id, paired_with) %>%
  filter(user_id < paired_with)

print(final_pairs)

Pros & Cons #

• Pros: Super straightforward, matches your "most picky first" logic, fast even for 300 users.
• Cons: Might not give the absolute global maximum total compatibility (but it’s close enough for most use cases, especially with your top-8 limits).

2. Global Optimal Method (Maximize Total Compatibility) #

If you want the absolute best possible total compatibility score across all pairs, we can use graph theory to solve this as a maximum weight perfect matching problem. This ensures no one is left out (for even numbers like 300) and the sum of all pair scores is as high as possible.

Step-by-Step Implementation #

We’ll use the igraph package for this:

library(igraph)
library(tidyverse)

# First, make sure you have a full compatibility score matrix where:
# - Rows and columns are user IDs
# - score_matrix[userA, userB] = the compatibility score between userA and userB
# (You mentioned you already calculated these, so we'll use that matrix)

# Generate all unique user pairs (avoid duplicate edges)
all_pairs <- expand.grid(user1 = rownames(score_matrix), 
                         user2 = rownames(score_matrix)) %>%
  filter(user1 < user2) %>%
  # Calculate combined weight (sum of both users' scores for each other)
  mutate(weight = score_matrix[user1, user2] + score_matrix[user2, user1])

# Create an undirected graph from the pairs
penpal_graph <- graph_from_data_frame(all_pairs, directed = FALSE)

# Compute the maximum weight perfect matching
optimal_matching <- max_weight_matching(penpal_graph, type = "perfect")

# Convert the result to a clean data frame
optimal_pairs <- tibble(user_id = optimal_matching$matching[,1], 
                        paired_with = optimal_matching$matching[,2]) %>%
  filter(user_id < paired_with) %>%
  mutate(user_id = as.integer(user_id), 
         paired_with = as.integer(paired_with))

print(optimal_pairs)

Pros & Cons #

• Pros: Guarantees the highest possible total compatibility score, no arbitrary priority biases.
• Cons: Requires a full score matrix (not just top 8), but since you already calculated scores for all pairs, this is easy to implement.

Quick Notes for Your Data #

• Double-check your raw data to fix any rows with missing X1-X8 values (your sample data has a few rows with fewer columns).
• If you have an odd number of users, you’ll need to adjust one pair or add a "waitlist"—but 300 is even, so no problem here!

内容的提问来源于stack exchange，提问作者Anna Hoehenrieder