卡牌洗牌的非正态抽样实现方案咨询

Great question! Let's break down how you can skew bridge hand distributions away from natural probabilities—either by tweaking sample() with custom weights, or using more controlled sampling methods to "flatten" the distribution curve.

The key to adjusting sample() for this use case is to apply dynamic weights as you deal each hand. We can penalize over-represented suits in the current hand, making it less likely to keep adding cards of the same suit and pushing the distribution toward more balanced splits.

Here's a modified version of your code that implements this logic:

# Set up
library(tidyverse)
library(glue)
set.seed(123)

# Build pack
pack <- expand.grid(rank = c("A", 2:9, "T", "J", "Q", "K"), suit = c("S", "H", "D", "C")) %>% 
  as_tibble(.name_repair = "minimal") %>% 
  mutate(card = paste(suit, rank, sep = "-"))

# Divide cards into hands with weighted sampling
for (i in 1:4) {
  # Start with empty hand (or existing cards if mid-deal)
  current_hand <- if (i == 1) tibble(card = character(0)) else get(glue("hand{i}"))
  
  # Calculate how many of each suit are already in the current hand
  suit_counts <- current_hand %>%
    separate(card, into = c("suit", "rank"), sep = "-") %>%
    count(suit, name = "count") %>%
    right_join(tibble(suit = c("S", "H", "D", "C")), by = "suit") %>%
    mutate(count = replace_na(count, 0))
  
  # Assign weights: lower weight for suits already over-represented in the hand
  # Formula: 1/(count + 1) → suits with 0 cards get highest priority (weight = 1)
  pack_with_weights <- pack %>%
    separate(card, into = c("suit", "rank"), sep = "-") %>%
    left_join(suit_counts, by = "suit") %>%
    mutate(weight = 1 / (count + 1)) %>%
    unite(card, suit, rank, sep = "-")
  
  # Deal remaining cards needed for the hand
  num_to_deal <- 13 - nrow(current_hand)
  temp <- sample(pack_with_weights$card, num_to_deal, replace = FALSE, prob = pack_with_weights$weight) %>% 
    as_tibble(.name_repair = "minimal") %>% 
    separate(value, sep = "-", into = c("suit", "rank")) %>% 
    mutate(
      suit = factor(suit, levels = c("S", "H", "D", "C")),
      rank = factor(rank, levels = c("A", "K", "Q", "J", "T", 9:2))
    ) %>% 
    arrange(suit, rank) %>% 
    unite("card", sep = "-")
  
  # Save the full hand and update the remaining pack
  full_hand <- bind_rows(current_hand, temp)
  assign(glue("hand{i}"), full_hand)
  pack <- pack %>% filter(!card %in% full_hand$card)
}

# Reassemble pack
pack <- bind_cols(hand1, hand2, hand3, hand4) %>% rename(N = 1, E = 2, S = 3, W = 4)

How this works: #

• For each remaining card, we calculate a weight based on how many cards of that suit the current hand already holds. Suits with fewer cards get higher weights, making them more likely to be picked next.
• You can tweak the weight formula to adjust the skew: for example, 1/(count^2 + 1) would penalize over-represented suits even more, leading to extremely balanced hands.

If you want full control over exact suit splits (instead of just skewing probabilities), you can pre-define how many cards of each suit go to each hand. This lets you enforce patterns like more 3-3-4-3 splits instead of the natural 4-4-3-2 distribution.

Here's an example:

# Set up
library(tidyverse)
library(glue)
set.seed(123)

# Build pack, grouped by suit
pack_by_suit <- expand.grid(rank = c("A", 2:9, "T", "J", "Q", "K"), suit = c("S", "H", "D", "C")) %>% 
  as_tibble(.name_repair = "minimal") %>% 
  group_by(suit) %>%
  nest() %>%
  rename(cards = data)

# Define your desired suit splits per hand (e.g., balanced 3/3/4/3 pattern)
desired_splits <- list(
  S = c(3, 3, 4, 3),
  H = c(4, 3, 3, 3),
  D = c(3, 4, 3, 3),
  C = c(3, 3, 3, 4)
)

# Initialize empty hands
hands <- map(1:4, ~tibble(card = character(0))) %>% set_names(glue("hand{1:4}"))

# Deal each suit according to your pre-defined splits
for (suit in c("S", "H", "D", "C")) {
  suit_cards <- pack_by_suit %>% filter(suit == !!suit) %>% pull(cards) %>% first() %>% mutate(card = paste(suit, rank, sep = "-"))
  splits <- desired_splits[[suit]]
  
  # Split the suit's 13 cards into the four hands
  dealt_cards <- suit_cards %>%
    slice_sample(n = 13) %>%
    mutate(hand_id = rep(glue("hand{1:4}"), splits)) %>%
    group_by(hand_id) %>%
    nest()
  
  # Add dealt cards to each hand
  for (hand_name in glue("hand{1:4}")) {
    cards_to_add <- dealt_cards %>% filter(hand_id == !!hand_name) %>% pull(data) %>% first()
    hands[[hand_name]] <- bind_rows(hands[[hand_name]], cards_to_add)
  }
}

# Tidy up hands and save to global environment
list2env(hands, envir = .GlobalEnv)
for (i in 1:4) {
  assign(glue("hand{i}"), get(glue("hand{i}")) %>%
    separate(card, into = c("suit", "rank"), sep = "-") %>%
    mutate(
      suit = factor(suit, levels = c("S", "H", "D", "C")),
      rank = factor(rank, levels = c("A", "K", "Q", "J", "T", 9:2))
    ) %>%
    arrange(suit, rank) %>%
    unite("card", sep = "-"))
}

# Reassemble pack
pack <- bind_cols(hand1, hand2, hand3, hand4) %>% rename(N = 1, E = 2, S = 3, W = 4)

Why this works: #

• You explicitly set the number of cards each hand gets per suit, so you can eliminate extreme splits entirely if needed. This is ideal for testing or demonstration purposes where you need consistent non-natural hand patterns.

If you want more flexibility beyond base R's sample(), consider these options:

• dplyr::slice_sample(): Tidyverse-friendly sampling with a weight_by parameter, which can simplify the weighted sampling code above.
• sampling::strata(): For stratified sampling if you want to enforce splits across multiple variables (like suit and rank).

内容的提问来源于stack exchange，提问作者Tech Commodities