困难随机化，基于频率排序

编程问答 2022-04-26

问题描述

| 我有一个这样的数据框： x = data.frame（A = c（\“ D1 \”，\“ D1 \”，\“ D1 \”，\“ D1 \”，\“ D1 \”，\“ D2 \”，\“ D3 \ “，\” D3 \“，\” D4 \“，\” D4 \“，\” D4 \“，\” D5 \“，\” D5 \“），B = c（\” A1 \“，\ “ A3 \”，\“ A4 \”，\“ A5 \”，\“ A6 \”，\“ A5 \”，\“ A5 \”，\“ A6 \”，\“ A6 \”，\“ A1 \“，\” A2 \“，\” A5 \“，\” A6 \“）） 
A        B  
D1  A1  
D1  A3  
D1  A4  
D1  A5  
D1  A6  
D2  A5  
D3  A5  
D3  A6  
D4  A6  
D4  A1  
D4  A2  
D5  A5  
D5  A6
为了按B列排序，B列中的实体具有不同的频率。 
A   B   freq(B)  
D1  A1  2  
D4  A1  2  
D4  A2  1  
D1  A3  1  
D1  A4  1  
D1  A5  4  
D2  A5  4  
D3  A5  4  
D5  A5  4  
D1  A6  4  
D3  A6  4  
D4  A6  4  
D5  A6  4
我想在数据帧x的B列上生成一个随机数据帧，但是只能在条目的频率相同或相似（+/-等级）的地方进行随机化。让我们说。现在，A2，A3，A4的频率为1，因此A2，A3和A4可以自由替换，但不能替换为A5，A6或A1。同样，由于A5和A6的频率为4，因此它们之间可以随机化。对于A1，这是唯一具有频率= 2（基于freq（B）排名第二）的条目，因为无法进行替换，所以为A1提供了特殊条件。 A1可以随机替换为A2，A3，A4（其等级比A1低1级（1，基于频率（B）排名第一））或A5 / A6（其等级1（4，根据2的排名，基于3rd）高于A1）。 R可以轻松完成吗？     

解决方法

        我的
permute
包中的函数很容易处理第一部分（目前仅在R-forge上） 
require(permute) ## install from R-forge if not available
x <- data.frame(A = c(\"D1\",\"D1\",\"D2\",\"D3\",\"D4\",\"D5\",\"D5\"),B = c(\"A1\",\"A3\",\"A4\",\"A5\",\"A6\",\"A1\",\"A2\",\"A6\"))
x <- x[order(x$B),]
x <- transform(x,freq = rep((lens <- sapply(with(x,split(B,B)),length)),lens))
set.seed(529)
ind <- permuted.index(NROW(x),control = permControl(strata = factor(x$freq)))
这使： 
R> x[ind,]
    A  B freq
10 D4 A1    2
1  D1 A1    2
11 D4 A2    1
2  D1 A3    1
3  D1 A4    1
12 D5 A5    4
4  D1 A5    4
9  D4 A6    4
13 D5 A6    4
5  D1 A6    4
6  D2 A5    4
8  D3 A6    4
7  D3 A5    4
R> ind
 [1]  2  1  3  4  5  9  6 12 13 10  7 11  8
我们可以包装这条语句以生成n个排列 
ctrl <- permControl(strata = factor(x$freq))
n <- 10
set.seed(83)
IND <- replicate(n,permuted.index(NROW(x),control = ctrl))
这使： 
> IND
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    2    2    1    2    1    2    1    2    1     1
 [2,]    1    1    2    1    2    1    2    1    2     2
 [3,]    3    5    4    3    5    5    4    5    5     5
 [4,]    5    3    5    5    3    4    5    4    4     4
 [5,]    4    4    3    4    4    3    3    3    3     3
 [6,]    9   12   11   12    6   10   13   10    8    13
 [7,]   10   11    6   11   13    7    7   12    7     9
 [8,]    8    9    9   10    8    6   11   13   12    10
 [9,]   12   10    8    6    9   13    9    6    9    11
[10,]   13    6   12    9    7    9    8    8   13     8
[11,]    6    7   10   13   12   11    6   11   10     7
[12,]   11    8   13    7   11    8   10    7    6    12
[13,]    7   13    7    8   10   12   12    9   11     6
现在，您还需要进行一些特殊采样。如果我理解正确，那么您想要确定哪个频率级别仅由单个B组成。然后，可能会随机地用从B中随机选择的B \替换该频率级别中的B \。 \在相邻的频率类别中。如果是这样，那么要替换正确的行会有点复杂，但是我认为下面的函数可以做到这一点： 
randSampleSpecial <- function(x,replace = TRUE) {
    ## have we got access to permute?
    stopifnot(require(permute))
    ## generate a random permutation within the levels of freq
    ind <- permuted.index(NROW(x),control = permControl(strata = factor(x$freq)))
    ## split freq into freq classes
    ranks <- with(x,split(freq,freq))
    ## rank the freq classes
    Ranked <- rank(as.numeric(names(ranks)))
    ## split the Bs on basis of freq classes
    Bs <- with(x,freq))
    ## number of unique Bs in freq class
    uniq <- sapply(Bs,function(x) length(unique(x)))
    ## which contain only a single type of B?
    repl <- which(uniq == 1)
    ## if there are no freq classes with only one level of B,return
    if(!(length(repl) > 0))
        return(ind) 
    ## if not,continue
    ## which of the freq classes are adjacent to unique class?
    other <- which(Ranked %in% (repl + c(1,-1)))
    ## generate uniform random numbers to decide if we replace
    Rand <- runif(length(ranks[[repl]]))
    ## Which are the rows in `x` that we want to change?
    candidates <- with(x,which(freq == as.numeric(names(uniq[repl]))))
    ## which are the adjacent values we can replace with
    replacements <- with(x,which(freq %in% as.numeric(names(uniq[other]))))
    ## which candidates to replace? Decision is random
    change <- sample(candidates,sum(Rand > 0.5))
    ## if we are changing a candidate,sample from the replacements and
    ## assign
    if(length(change) > 0)
        ind[candidates][change] <- sample(ind[replacements],length(change),replace = replace)
    ## return
    ind
}
要使用此功能，我们要做： 
R> set.seed(35)
R> randSampleSpecial(x)
 [1]  2  1  5  3  4  6  9 12 10 11  7  8 13
我们可以将其包装成
replicate()
调用以产生许多这样的替换： 
R> IND <- replicate(10,randSampleSpecial(x))
R> IND
      [,]   11    3    6    4    2    1    1    2   10     3
 [2,]    1   11    1   12   11   11    2    1    1    13
 [3,]    4    5    4    3    4    3    4    5    5     4
 [4,]    5    4    5    5    5    4    5    3    3     3
 [5,]    3    3    3    4    3    5    3    4    4     5
 [6,]   11    7   11   12    9    6    7    8    9     9
 [7,]   13   12   12    7   11    7    9   10    8    10
 [8,]   10    8    9    8   12   12    8    6   13     8
 [9,]    7    9   13   10    8   10   13    9   12    11
[10,]    6   11   10   11   10   13   12   13   10    13
[11,]   12   10    6    6    6    9   11   12    7    12
[12,]    9    6    7    9    7    8   10    7    6     7
[13,]    8   13    8   13   13   11    6   11   11     6
对于此数据集，我们知道它可能是已排序的“ 11”中的第1行和第2行，我们可能希望将其替换为其他频率类的值。如果我们没有进行替换，则ѭ12first的前两行将仅在其中具有值
1
或
2
（请参见前面的
IND
）。在新的
IND
中，前两行的值不是
1
或
2
，我们将其替换为来自相邻频率类别之一的B。 我的功能假定您要： 只能随机将同质频率等级中的元素替换为相邻等级之一！如果您想始终更换，则我们将更改功能更改为适合。 如果我们要进行替换，则该替换可以是任何替换，并且如果我们需要多个替换，则可以多次选择同一替换。如果需要，在通话中设置ѭ19即可进行采样而无需更换。 该函数假定您只有一个单一的单频率类。如果应该容易地使用两个或多个单特异性类上的循环进行修改，但这会使函数复杂化，并且由于您对问题的描述不太清楚，因此我保持了简单性。     ,        @Gavin为您提供了一种不错的方法，并询问是否有人可以提出更简单的方法。下一个功能仅基于基本功能执行相同的操作。它使用
count
处理频率，并考虑到最小的最大频率只有一个相邻等级。在这种情况下，Gavin的功能会出错。 
Permdf <- function(x,v){
  # some code to allow Permdf(df,var)
  mc <- match.call()
  v <- as.quoted(mc$v)
  y <- unlist(eval.quoted(v,x))
  # make bins with values in v per frequency
  freqs <- count(x,v)
  bins <- split(freqs[[1]],freqs[[2]])
  nbins <- length(bins)
  # define the output
  dfid <- 1:nrow(x)

  for (i in 1:nbins){
    # which id\'s to change
    id <- which(y %in% bins[[i]])

    if(length(bins[[i]]) > 1){
      # in case there\'s more than one value for that frequency
      dfid[id] <- sample(dfid[id])
    } else {
      bid <- c(i-1,i,i+1)
      # control wether id in range
      bid <- bid[bid > 0 & bid <=nbins]
      # id values to choose from
      vid <- which(y %in% unlist(bins[bid]))
      # random selection
      dfid[id] <- sample(vid,length(id),replace=TRUE)
    }
  }
  #return
  dfid
}
这可以用作 
Permdf(x,B)
    ,        关于随机化问题的下半部分还不清楚，但这是一个开始。当您更新问题时-我将相应地更新答案。下面的代码添加B列的计数信息，然后根据我们添加的频率列的值对行进行采样。我认为，这里需要做的只是修改可用于采样的列的可用性，但是请确认您想要的列。 
require(plyr)
x <- merge(x,count(x,\"B\"))
ddply(x,\"freq\",function(x) sample(x))
    
困难困难基于基于排序排序排序随机化频率频率