Блог

У меня есть фрейм данных, подобный этому:

x = данные.кадр (A= c («D1», «D1», «D1», «D1», «D1», «D2», «D3», «D3», «D4», «D4», «D4», «D5», «D5»), B = c («A1», «A3», «A4», «A5», «A6», «A5», «A5», «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  
  

Я хочу сгенерировать случайный фрейм данных в столбце B фрейма данных x, но рандомизация может быть выполнена только там, где частота записей одинакова или подобна ( / — один ранг). Давайте скажем. теперь A2, A3, A4 имеют частоту 1, так что A2, A3 и A4 могут свободно заменяться друг другом, но не для A5 и A6, ни для A1. Аналогично, поскольку A5 и A6 имеют частоту = 4, они могут быть рандомизированы между собой. Для A1, которая является единственной записью, частота = 2 (2-й ранг на основе freq (B)), поскольку замена невозможна, для A1 были предоставлены особые условия. A1 может быть случайным образом заменен на A2, A3, A4 (которые занимают один класс (1, ранг 1 на основе частоты (B)) ниже, чем A1) или A5 / A6 (которые занимают один класс (4, ранг 2, ранг 3 на основе частоты (B)) выше, чем A1).

Возможно ли это легко выполнить с помощью R?

Первая часть легко обрабатывается функциями в моем permute пакете (на данный момент только в R-forge)

 require(permute) ## install from R-forge if not available
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"))
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, split(B, 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
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]   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
  

Для этого набора данных мы знаем, что это строки 1 и 2 в отсортированном x , которые мы, возможно, захотим заменить значениями из других классов freq. Если бы мы не делали замен, в первых двух строках IND были бы значения 1 или 2 только в них (см. IND из предыдущего). В новом IND , где значение в первых двух строках не является 1 или 2 , мы заменили его на B из одного из смежных классов частот.

Моя функция предполагает, что вы хотите:

1. Заменяйте элементы в однородном частотном классе только случайным образом на элементы из соседнего класса! Если вы хотите всегда заменять, то мы меняем функцию, чтобы она соответствовала.
2. Что если мы выполняем замену, то этой заменой может быть любая из замен, и если нам требуется более 1 замены, одна и та же замена может быть выбрана более одного раза. Установите replace = FALSE в вызове для выполнения выборки без замены, если это то, что вы хотите.
3. Функция предполагает, что у вас есть только один моноспецифичный класс частот. If должно быть легко изменить, используя цикл над двумя или более моноспецифичными классами, но это усложняет функцию, и поскольку ваше описание проблемы было не слишком ясным, я все упростил.

@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 amp; 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))