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

时间:2018-01-31 16:36:09

标签: r algorithm

说我有这样的数据框:

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几乎总会导致失败。我想知道是否有更好的算法来做到这一点?也许是一种生灭算法?

1 个答案:

答案 0 :(得分: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))
}

现在,我们需要将数据拆分为具有相同timeside的行列表,并以最大的开始采样:

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)

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