Question

说我有这样的数据框：

d <- data.frame(time = c(1,3,5,6,11,15,15,18,18,20), side = c("L", "R", "R", "L", "L", "L", "L", "R","R","R"), id = c(1,2,1,2,4,3,4,2,1,1), stringsAsFactors = F)
d

   time side id
1     1    L  1
2     3    R  2
3     5    R  1
4     6    L  2
5    11    L  4
6    15    L  3
7    15    L  4
8    18    R  2
9    18    R  1
10   20    R  1

我希望置换id变量并保持其他两个不变。但是，重要的是，在我的最终排列中，我不希望同时在同一侧拥有相同的id。例如，有两次/两次可能发生这种情况。在时间15和18的原始数据中，在同一侧有两个唯一的id（左边是时间15，右边是时间18）。如果我使用sample进行置换，则可能会在同一时间/侧面组合中显示相同的ID。

例如，

set.seed(11)
data.frame(time=d$time, side=d$side, id=sample(d$id))

   time side id
1     1    L  1
2     3    R  1
3     5    R  4
4     6    L  1
5    11    L  4
6    15    L  2
7    15    L  3
8    18    R  2
9    18    R  2
10   20    R  1

这里，id = 2出现在“R”侧的时间18的两行上。在我需要的排列中不允许这样做。

一种解决方案就是强行使用 - 例如说我需要100个排列，我可以产生500个并丢弃那些不符合标准的那些。但是，在我的实际数据中，我有数百行，只使用sample几乎总会导致失败。我想知道是否有更好的算法来做到这一点？也许是一种生灭算法？

Answer 1

设定：

library(tidyverse)
d <- data.frame(time = c(1,3,5,6,11,15,15,18,18,20), side = c("L", "R", "R", "L", "L", "L", "L", "R","R","R"), id = c(1,2,1,2,4,3,4,2,1,1), stringsAsFactors = F)
d <- rownames_to_column(d)

我希望rownames能够在最后按顺序将它放回去。

你需要一个带向量的函数（比如你的id向量）并返回一个大小为n的样本，其约束条件必须是不同的值，如下所示（假设您想要的采样实际上可以发生，即您没有用完样品的样品）。为了方便起见，这也会返回＆＃34;剩菜和＃34;那些没有采样的：

samp_uniq_n <- function(vec, n) {
  x <- vec
  out <- rep(NA, n)
  for(i in 1:n) {
    # Here would be a good place to make sure sampling is even possible.
    probs <- prop.table(table(x))
    out[i] <- sample(unique(x), 1, prob=probs)
    x <- x[x != out[i]]
    vec <- vec[-min(which(vec == out[i]))]
  }
  return(list(out=out, vec=vec))
}

现在，我们需要将数据拆分为具有相同time和side的行列表，并以最大的开始采样：

id <- d$id
d_split <- d %>% select(-id) %>% split(., list(d$time, d$side), drop = TRUE)
d_split_desc <- d_split[order(-sapply(d_split, nrow))]

然后我们可以自己进行抽样：

for(i in seq_along(d_split_desc)) {
  samp <- samp_uniq_n(id, nrow(d_split_desc[[i]]))
  this_id <- samp$out
  d_split_desc[[i]]$id <- this_id
  id <- samp$vec
}

最后，一些清理：

d_permute <- do.call(rbind, d_split_desc) %>% 
  arrange(as.numeric(rowname)) %>% 
  select(-rowname)

将所有这些放在一个重要的功能中是一种烦恼，我会留下任何感兴趣的人。

置换数据帧但必须具有唯一的行

1 个答案: