R - случайная выборка из матрицы с использованием распределения для обозначения числа нулей в каждом столбце - стратифицированная выборка

Question

Я пытаюсь случайным образом произвести выборку из матрицы ( b ниже), но я хочу, чтобы полученная матрица выборок имела пропорцию нулей в каждом столбце, равную доле другой матрицы ( a ниже). Я пытаюсь использовать функцию sample(), но у меня не так много радости. Ниже приведен некоторый воспроизводимый код, который, я надеюсь, объяснит мою проблему:

---

РЕДАКТИРОВАТЬ: Просто упомянуть, что я не хочу, чтобы какие-либо строки были увеличены или отредактированы, а вместо этого была сделана случайная выборка из b так результирующая матрица; b_sample приблизительно будет иметь равное распределение нулей для a

---

set.seed(1234)
# matrix a is the matrix that holds the distribution of zeros I want to match
a <- matrix(as.integer(rexp(200, rate=.1)), ncol=20)
# matrix b is the matrix to be sampled from 
b <- matrix(as.integer(rexp(2000, rate=.1)), ncol=20)

a выглядит так:

     [,1] [,2] [,3] [,4] [,5]
[1,]    6    0    6    1   22
[2,]   19    6    0   23   19
[3,]    8   22    8    5    0
[4,]   24   17   28    3    0

b выглядит так:

      [,1] [,2] [,3] [,4] [,5]
 [1,]    1    1   10    5    9
 [2,]   26    1    3    2    2
 [3,]    4    8    3    0    0
 [4,]    2   10   35    3   11
 [5,]    1    3   16    0    6
 [6,]    2    4    2   16    2
 [7,]    3   18   13    6   17
 [8,]    0    2    9    0   13
 [9,]    2   15    6   27   30
[10,]    1    2    7    9   15
[11,]   13    0    5    1    2
[12,]   18   12    9   27   33
[13,]    0   20    3   18    1
[14,]    5    7    7   16    4
[15,]    5    6    4    5    2
[16,]    0    7    5   10    7
[17,]    3   20    5   14   34
[18,]   28    0   10    5    8
[19,]   33    0    2    6   13
[20,]    7   28    0   11    8

Я извлекаю распределение нулей в каждом столбце a для использования в выборке

dist<-apply(a,2, function(x) sum(x!=0)/length(x)) 
dist
[1] 1.00 0.75 0.75 1.00 0.50

Затем я go пытаюсь выбрать из b для хранения того же числа строки как

b_sample<-b[sample(x=nrow(b),
                   size=4,
                   replace=F
                   )
            ,]

Это будет работать, но я хочу, чтобы b_sample имел одинаковое количество нулей в каждом столбце, как a. Я пытался сделать это

b_sample<-b[sample(x=nrow(b),
                   size=4,
                   replace=F,
                   prob=dist
                   )
            ,]

, но я получаю сообщение об ошибке:

Error in sample.int(x, size, replace, prob) : 
  incorrect number of probabilities

Я не уверен, что у меня неправильный формат, или это функция sample() не функция коррекции вообще использовать. Любая помощь будет принята с благодарностью!

---

РЕДАКТИРОВАТЬ 2: Обновление ниже

---

Я нашел способ для выборки из b и сохранить пропорции нулей в полученном b_sample так же, как и оригинал b. Это не то, что я пытаюсь получить, я хочу, чтобы пропорции были равны пропорциям в a, но это могло бы дать лучшее представление о том, что я хочу сделать. Ниже приведен пример разработки приведенного выше примера

Сначала я сделал b в кадре данных и проиндексировал строки, чтобы использовать dplyr и groupby()

b_df<-as.data.frame(b)
b_df <- b_df %>%
  mutate(n = row_number()) %>% #create row number
  select(n, everything()) # put row number at the front of the dataset
b_df
    n V1 V2 V3 V4 V5
1   1 19  1 29  2  9
2   2  7 20  1  3  9
3   3  3 25  8  9 22
4   4  9  0 20  9  0
5   5  2 12 14  4  2
6   6 10 22  9  1  9
7   7  0  9 16  1  4
8   8  3  3 14 23  2
9   9  7  0  7  1  0
10 10  9  0 26  2  6
11 11  4 19  0  2  6
12 12  0  2  1  7  4
13 13 16 16 25  2  3
14 14  0  1  1  7  9
15 15  8 14  0  9  5
16 16  0 14  9  5  0
17 17 43 27 14  1  4
18 18  9  0 13  4  9
19 19  0  8  3  9 13
20 20 34 36  1  7 20

I, а затем создайте двоичный фрейм данных, чтобы указать, имеет ли каждая ячейка 0 или значение

b_df_0[,-1]<-as.data.frame(lapply(b_df[,-1],function(x) x==0))
b_df_0
    n    V1    V2    V3    V4    V5
1   1 FALSE FALSE FALSE FALSE FALSE
2   2 FALSE FALSE FALSE FALSE FALSE
3   3 FALSE FALSE FALSE FALSE FALSE
4   4 FALSE  TRUE FALSE FALSE  TRUE
5   5 FALSE FALSE FALSE FALSE FALSE
6   6 FALSE FALSE FALSE FALSE FALSE
7   7  TRUE FALSE FALSE FALSE FALSE
8   8 FALSE FALSE FALSE FALSE FALSE
9   9 FALSE  TRUE FALSE FALSE  TRUE
10 10 FALSE  TRUE FALSE FALSE FALSE
11 11 FALSE FALSE  TRUE FALSE FALSE
12 12  TRUE FALSE FALSE FALSE FALSE
13 13 FALSE FALSE FALSE FALSE FALSE
14 14  TRUE FALSE FALSE FALSE FALSE
15 15 FALSE FALSE  TRUE FALSE FALSE
16 16  TRUE FALSE FALSE FALSE  TRUE
17 17 FALSE FALSE FALSE FALSE FALSE
18 18 FALSE  TRUE FALSE FALSE FALSE
19 19  TRUE FALSE FALSE FALSE FALSE
20 20 FALSE FALSE FALSE FALSE FALSE

. Затем я использую group_by и sample_frac из dplyr для выборки из b, чтобы равняться количеству выборок в a.

proportion <- nrow(a)/nrow(b)
sample <- b_df_0 %>%
  group_by(V1,V2,V3,V4,V5) %>% #any number of variables you wish to partition by proportionally
  sample_frac(proportion) # proportion of the original df you wish to sample

b_df[b_df$n %in% sample$n,]
#The above approach would work if you can get a proportions = b proportions
    n V1 V2 V3 V4 V5
2   2  7 20  1  3  9
19 19  0  8  3  9 13
20 20 34 36  1  7 20

Этот подход не тот, который я хочу, однако, поскольку пропорции основаны на b, когда я хочу, чтобы они основывались на a. Любая помощь в том, как это сделать, будет потрясающей! Спасибо!

Answer 1

Проблема состояла в том, чтобы попытаться уменьшить частоту большой матрицы до размера меньшей матрицы, при этом также гарантируя, что пропорции нулей для каждой переменной в матрице пониженной выборки равны долям меньшей матрицы.

Итак, после нескольких дней исследований я нашел метод решения проблемы, которую я имел, без использования какой-либо предопределенной функции для выполнения тяжелой работы. Как выяснилось, это была проблема перестановок и, как я болезненно выяснил, как количество строк в матрице, которое мне нужно для выборки из b, и количество строк в матрице, которое мне нужно уменьшить до размер a увеличился, проблема стала невозможной для вычислительных вычислений. Например, если матрица, которую я пытаюсь выбрать, содержала 200 строк, а размер матрицы, которую я пытаюсь уменьшить, равен 20, это дает n! / (Nr)! перестановки или в r

> factorial(200)/factorial(200-20)
[1] NaN

Эта проблема с размером числа перестановок пожирает вычислительную мощность и память и хорошо покрыта переполнением стека . Итак, в интересах времени и памяти я, очевидно, не мог проверить каждую перестановку. Я решил сделать две вещи, чтобы обойти это; во-первых, я бы проверял только часть перестановок, которые дают мне 95% -ную вероятность получить одну перестановку в верхних 5% решений (я определяю вершину здесь как имеющую наилучшее приближение нулевых распределений к a), а во-вторых, я остановился бы рано, если бы я нашел решение, где нулевое распределение каждой переменной было в пределах 0,05 a. Приведенный ниже код описывает решение:

Сначала давайте создадим матрицу для выборки из b и матрицу, чтобы получить размер и нулевое распределение для уменьшения до a

set.seed(1234)
# matrix a is the matrix that holds the distribution of zeros I want to match
a <- matrix(as.integer(rexp(200, rate=.1)), ncol=20)
# matrix b is the matrix to be sampled from 
b <- matrix(as.integer(rexp(2000, rate=.1)), ncol=20)

Далее я работаю над распределением нулей. Я пытаюсь реплицировать

zero_dist_to_replicate<-apply(a,2, function(x) 
> zero_dist_to_replicate
 [1] 0.8 0.8 0.9 0.6 0.7 0.9 1.0 0.8 1.0 1.0 0.8 0.9 1.0 1.0 0.9 0.9 0.9 0.9 1.0 0.9

. Затем я создаю переменные, чтобы контролировать число перестановок и их ошибки

  perms_used <- list()
  error <- vector()
  answer <- matrix()

. много случайных выборок из b, которые мне нужно взять, чтобы получить перестановку в верхних 5%, 95% времени я использую

ceiling(log(1-0.95)/log(1-0.05))
[1] 59

Теперь я запускаю некоторое время l oop, которое случайным образом выбирает из b и проверяет, выполняется ли мое второе условие сверху, если это не так, я сохраняю перестановку и связанную с ней ошибку и продолжаю, пока не найду ту, которая удовлетворяет второму условию, или попробую 59 условий. Если я попробую 59, то я верну тот с ближайшим нулевым распределением к a

counter<-1
while(counter < 59){
  perm <- NULL
  #Keep picking random permutations until you find one that hasn't been checked before
  while(is.null(perm) || perm %in% perms_used){
    #sample used to generate random numbers to pick rows from b, 
    #-1 and +1 used so random number picked doesn't include 0
    perm <- sample((n-1),num_vars,replace=T)+1
   }
   subsample_set <- b[perm,]
   #check distribution of zeros of this permutation
   subsample_set_dist <- apply(subsample_set,2, function(x) sum(x!=0)/length(x))
   #if the permuted subsample's distribution of zeros is within .05 
   #for each variable of other matrix end early
   diff <- abs(subsample_set_dist-zero_dist_to_replicate)
   if(all(diff <= 0.05)==T){
      answer <- subsample_set
      break
   }
    #getting the sum of the error across all variables
    error[counter]<-sum(diff)
    perms_used[[counter]]<-perm
    counter = counter+1
  }
  if(all(is.na(answer))){
   #return first row with the minimum error
   best_subsample<-perms_used[which(error == min(error))]
   answer <- matrix_to_sample[best_subsample[[1]],])
  }

Answer 2

Если p - это доля 0 в столбце A, а b_rows - количество строк в B.

Пример для столбца j в B:

B [sample (1: b_rows, b_rows * р), J] = 0