Non-normal sampling for card shuffling - r

Question

I have a script that uses sample() to shuffle a pack of cards into four hands - Shown below.
This script produces normally distributed hand splits. That is the distributions of the 13 cards in a suit across the four hands will be "4432" 21.6% of the time, "5442" 15.5% of the time, ... - See here: https://en.wikipedia.org/wiki/Contract_bridge_probabilities#Hand%20pattern%20probabilities.
Is there a way to make sample() give non-normal distributions, e.g. Flatten the profile, so that the distributions across the hands deviate from the expected probabilities? sample() can take a weighting parameter, but can't see how to use this to achieve my goals. Alternatively, is there another sampling function that could provide this?
Thank you,
TC
# Set up
library(tidyverse)
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
for (i in 1:4) {
temp <- sample(pack$card, 13, replace = FALSE) %>%
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 = "-")
assign(glue::glue("hand{i}"), temp)
pack <- pack %>%
filter(!card %in% unname(unlist(temp)))
}
# Reassemble pack
pack <- hand1 %>%
cbind(hand2) %>%
cbind(hand3) %>%
cbind(hand4) %>%
rename(N = 1, E = 2, S = 3, W = 4)

Answer 1

You can simplify the process of creating the deck, shuffling, and dealing as follows:
# Create the deck
Suit <- c("S", "H", "D", "C")
Rank <- c("A", 2:9, "T", "J", "Q", "K")
Deck <- data.frame(Rank=rep(Rank, 4), Suit=rep(Suit, each=13))
# Shuffle and deal
Shuffle <- Deck[sample(nrow(Deck)), ] # Shuffle the deck
Hand <- factor(rep(c("N", "E", "S", "W"), 13), levels=c("N", "E", "S", "W"))
Deal <- data.frame(Hand, Shuffle)
Now deal is a data frame showing the cards in each hand. To get the distribution of cards by suit:
xtabs(~Suit+Hand, Even)
# Hand
# Suit N E S W
# C 3 3 3 4
# D 3 3 4 3
# H 3 4 3 3
# S 4 3 3 3
To get the hands:
split(Deal, Deal$Hand)
# $N
# Hand Rank Suit
# 12 N Q S
# 2 N 2 S
# 37 N J D
# 49 N T C
# 43 N 4 C
# 17 N 4 H
# 33 N 7 D
# 26 N K H
# 13 N K S
# 44 N 5 C
# 18 N 5 H
# 46 N 7 C
# 11 N J S
. . . . .
Since you mention Hand Pattern Probabilities, it may be helpful to show how you can generate them empirically:
HPP <- function() {
Shuffle <- Deck[sample(nrow(Deck)), ] # Shuffle the deck
Hand <- factor(rep(c("N", "E", "S", "W"), 13), levels=c("N", "E", "S", "W"))
Deal <- data.frame(Hand, Shuffle)
tbl <- xtabs(~Suit+Hand, Deal)
return(unname(apply(tbl, 1, function(x) paste(sort(x, decreasing=TRUE), collapse="-"))))
}
X <- replicate(1000, HPP())
HP <- prop.table(sort(table(X), decreasing=TRUE))
as.matrix(HP)
# [,1]
# 4-4-3-2 0.22200
# 5-3-3-2 0.14925
# 5-4-3-1 0.12075
# 4-3-3-3 0.11225
# 5-4-2-2 0.10775
# 6-3-2-2 0.05175
# 6-4-2-1 0.04850
# . . . .
To get more "even" distributions of cards by suit, you have to break the random distribution of the shuffle, for example we can shuffle the rank values in the deck but preserve the order of the suits:
Even <- Deck
Even$Rank <- c(replicate(4, sample(Rank)))
Even <- data.frame(Hand, Even)
Now the card values will differ, but the distribution by suit will always be the same.