R 将一个向量元素分配给同一向量中的另一个元素，该向量不是它本身（秘密圣诞老人算法）

我有一个办公室秘密圣诞老人。每个人都需要指定一个人为其购买礼物。为了简单起见，让我们写信给这些人

首先，我创建了名为

peeps

# People
peeps <- letters[1:20]

然后，我对这些人进行抽样，并将一个给予者分配给一个接受者

# Create data frame of givers and receiver 
data.frame(giver = peeps, receiver = sample(peeps, length(peeps))) 

#    giver receiver
# 1      a        l
# 2      b        h
# 3      c        d
# 4      d        b
# 5      e        e   <-  Problem!!!
# 6      f        j
# 7      g        s
# 8      h        n
# 9      i        g
# 10     j        t
# 11     k        q
# 12     l        f
# 13     m        k
# 14     n        i
# 15     o        a
# 16     p        m
# 17     q        p
# 18     r        c
# 19     s        r
# 20     t        o

此特定案例引发以下错误

# Error in sample.int(length(x), size, replace, prob) : 
#   invalid first argument

如果我们查看生成的数据帧，您将看到它适用于除最后一个人之外的所有人

res

#    giver receiver
# 1      a        k
# 2      b        h
# 3      c        b
# 4      d        s
# 5      e        n
# 6      f        i
# 7      g        m
# 8      h        l
# 9      i        d
# 10     j        q
# 11     k        p
# 12     l        j
# 13     m        r
# 14     n        e
# 15     o        c
# 16     p        o
# 17     q        g
# 18     r        f
# 19     s        a
# 20     t         

t

尚未分配接收器，但剩下的唯一接收器是<代码>t

# Check which letters are left
peeps

#[1] "t"   <- Same as final letter!!!

#检查剩下的字母
窥视
#[1] “t”您似乎在谈论（无定点置换）。根据一个经典的概率结果，随机选择的排列是一种错乱的概率本质上是1/e，与从中取样的集合的大小无关。只需使用一种简单的点击和错过的方法。使用sample（）生成随机排列，直到得到一个有效的排列。平均而言，大约有3次试验会取得成功

derangement <- function(v){
  while(TRUE){
    p <- sample(v)
    if(all(p != v)) return(p)
  }
}

peeps <- letters[1:20]
set.seed(43)
print(derangement(peeps))

你可以洗牌，然后把它们和下一个配对

peeps <- letters[1:20]
giver <- sample(peeps)        #random order
receiver <- giver[c(2:length(giver), 1)]

df <- data.frame(giver, receiver)
df <- df[order(df$giver), ]   #restore original order

df
   giver receiver
19     a        o
16     b        t
8      c        f
11     d        i
10     e        d
9      f        e
7      g        c
15     h        b
12     i        k
1      j        m
13     k        s
4      l        r
2      m        p
18     n        a
20     o        j
3      p        l
6      q        g
5      r        q
14     s        h
17     t        n

peeps它必须是随机的吗？你可以把每个字母移动一个，然后从“z”旋转回“a”吗？如果随机性很重要，只需将字母随机分配给这些人…@user2474226是的，它必须是随机的。对不起，我应该在问题中说明。可能是重复的吗？谢谢你富有洞察力的回答。跟踪和错误听起来是一个非常有效的解决方案。不过出于好奇：还有其他选择吗？@Lyngbakr我现在还不知道。正如您所发现的，处理一系列随机选择是很棘手的，因为早期的选择可能会排除以后的可行选择。即使你找到了这个问题的解决方案，也很难证明由此产生的混乱是从所有混乱中统一选择的。命中和未命中方法的一个优点是它的采样均匀。这是一个很好的解决方案！
derangement <- function(v){
  while(TRUE){
    p <- sample(v)
    if(all(p != v)) return(p)
  }
}

peeps <- letters[1:20]
set.seed(43)
print(derangement(peeps))

[1] "j" "r" "b" "l" "f" "i" "t" "g" "c" "n" "d" "s" "p" "o" "q"
[16] "k" "a" "e" "h" "m"

peeps <- letters[1:20]
giver <- sample(peeps)        #random order
receiver <- giver[c(2:length(giver), 1)]

df <- data.frame(giver, receiver)
df <- df[order(df$giver), ]   #restore original order

df
   giver receiver
19     a        o
16     b        t
8      c        f
11     d        i
10     e        d
9      f        e
7      g        c
15     h        b
12     i        k
1      j        m
13     k        s
4      l        r
2      m        p
18     n        a
20     o        j
3      p        l
6      q        g
5      r        q
14     s        h
17     t        n