Выбор уникальных значений без повторения столбцов

Question

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

Итак, начиная с df, в котором 1 - это годы, есть наблюдение для этого человека, а 0 - годы, когда нет наблюдения для этого человека:

df <- data.frame(Ind   = c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k"),
             Year1 = c(1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0), 
             Year2 = c(0, 0, 1, 1, 1, 0, 0, 1, 0, 1, 0), 
             Year3 = c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1), 
             Year4 = c(0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1))

выглядит как

Я бы хотел закончить с чем-то вроде этого

РЕДАКТИРОВАТЬ: пытается применить предложенные решения (и не удается)

(1) ответ Эрча:

df <- as_tibble(df)

year.weights <- df %>% 
  gather(Year, Obs, -Ind) %>% 
  group_by(Year) %>% 
  summarize(wt = sum(Obs)) %>% 
  ungroup


df %>% 
      gather(Year, Obs, -Ind) %>%
      filter(Obs == 1) %>% 
      left_join(year.weights, by = "Year") %>% 
      group_by(Ind) %>% 
      sample_n(1, weight = 1 / wt) %>% 
      select(-wt) %>% 
      spread(Year, Obs) %>% 
      ungroup

Это дает ошибку Error: 'by' can't contain join column 'Year' which is missing from RHS, которая появляется на шаге left_join. Я пытаюсь решить эту проблему, задав имя "Год" единственной переменной в RHS

.

names(year.weights) <- "Year"

Но теперь это дает новую ошибку: Error in left_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches) : Can't join on 'Year' x 'Year' because of incompatible types (numeric / character), которая действительно имеет большой смысл, поскольку столбец Year в LHS содержит Year1, Year2, Year3 и т. Д., В то время как столбец Year в RHS содержит число 27.

Это так далеко, как я понял, потому что я не вижу, чего пытался достичь earch, но я верю, что с помощью этого n_sample и аргумента веса можно найти реальное решение, но я пока не могу его увидеть ,

(2) Ответ Майки:

Это работает хорошо (я не получаю ошибку, которую я получал раньше), но это не гарантирует, что я получу одинаковое (или подобное) число 1 для каждого столбца "Год".

Итак, если я запускаю код пару раз для тестирования, я получаю:

# first time
      [,1] [,2] [,3] [,4]
 [1,]    0    0    0    1
 [2,]    1    0    0    0
 [3,]    0    0    1    0
 [4,]    0    1    0    0
 [5,]    1    0    0    0
 [6,]    0    0    1    0
 [7,]    0    0    0    1
 [8,]    0    1    0    0
 [9,]    0    0    0    1
[10,]    0    0    0    1
[11,]    0    0    0    1

# second time
      [,1] [,2] [,3] [,4]
 [1,]    1    0    0    0
 [2,]    1    0    0    0
 [3,]    0    0    1    0
 [4,]    0    1    0    0
 [5,]    0    0    0    1
 [6,]    1    0    0    0
 [7,]    1    0    0    0
 [8,]    0    0    0    1
 [9,]    0    0    0    1
[10,]    0    0    0    1
[11,]    0    0    1    0

(3) Ответ Андре Элрико:

У него та же проблема, что и у ответа (2), он не гарантирует равное число 1 для каждого года: см. Два случайных вывода:

# fist try
   Ind Year1 Year2 Year3 Year4
1    a    NA    NA    NA     1
2    b    NA    NA     1    NA
3    c    NA    NA     1    NA
4    d    NA     1    NA    NA
5    e     1    NA    NA    NA
6    f    NA    NA     1    NA
7    g     1    NA    NA    NA
8    h    NA    NA    NA     1
9    i    NA    NA    NA     1
10   j    NA    NA    NA     1
11   k    NA    NA     1    NA

# second try
   Ind Year1 Year2 Year3 Year4
1    a     1    NA    NA    NA
2    b     1    NA    NA    NA
3    c    NA    NA     1    NA
4    d    NA    NA     1    NA
5    e    NA     1    NA    NA
6    f    NA    NA    NA     1
7    g    NA    NA    NA     1
8    h    NA    NA    NA     1
9    i    NA    NA    NA     1
10   j    NA     1    NA    NA
11   k    NA    NA     1    NA

(4) Ответ Паолоусеби имеет ту же проблему, что и предыдущие. Не гарантирует одинаковое количество выбранных 1 с в строке:

# first try
   Ind Year1 Year2 Year3 Year4
1    a     1    NA    NA    NA
2    b    NA    NA    NA     0
3    c    NA    NA     1    NA
4    d    NA    NA    NA     0
5    e    NA    NA     1    NA
6    f    NA    NA    NA     1
7    g     1    NA    NA    NA
8    h    NA    NA     0    NA
9    i    NA    NA    NA     1
10   j    NA    NA    NA     1
11   k    NA    NA     1    NA

# second try
   Ind Year1 Year2 Year3 Year4
1    a    NA    NA    NA     1
2    b    NA     0    NA    NA
3    c    NA     1    NA    NA
4    d    NA    NA    NA     0
5    e    NA    NA    NA     1
6    f    NA     0    NA    NA
7    g    NA     0    NA    NA
8    h    NA    NA     0    NA
9    i    NA    NA     0    NA
10   j    NA    NA     0    NA
11   k    NA     0    NA    NA

Answer 1

m   <- df[-1]
IND <- rowSums(m) > 0
m[] <- NA
m[cbind(which(IND),max.col(df[-1])[IND])] <- 1
cbind(df[1],m)

результат:

#   Ind Year1 Year2 Year3 Year4
#1    a     1    NA    NA    NA
#2    b    NA    NA     1    NA
#3    c    NA    NA     1    NA
#4    d    NA    NA     1    NA
#5    e    NA    NA     1    NA
#6    f     1    NA    NA    NA
#7    g    NA    NA    NA     1
#8    h    NA    NA    NA     1
#9    i    NA    NA    NA     1
#10   j    NA     1    NA    NA
#11   k    NA    NA     1    NA

---

если вам не нравится просто помещать переменные в глобальную среду:

(function(df){
    m   <- df[-1]
    IND <- rowSums(m) > 0
    m[] <- NA
    m[cbind(which(IND),max.col(df[-1])[IND])] <- 1
    cbind(df[1],m)
})(df)   # run this n-times

Answer 2

Вот некоторый код. Может быть, не так элегантно, но это начало:

new_mat = function(df, max_iter = 100){
    ind_names <- df[,1]
    df <- df[,-1]
    n = NROW(df)
    k = NCOL(df)
    max_col = ceiling(n / k)
    resample = function(x, ...) x[sample.int(length(x), ...)]
    one_hot = function(i, n){
        x = double(n)
        x[i] = 1
        return (x)
        }
    counter = 0
    flag = TRUE
    while (flag && counter <= max_iter){
        counter = counter + 1
        out = matrix(0, n, k)
        weights = rep(max_col, k)
        index = sample(1:n)
        c2 = 0
        for (i in index){
            ind = which(df[i,] == 1)
            probs = weights[ind]
            if (max(probs) == 0)
                break
            out[i,] = one_hot(resample(ind, size = 1, prob = probs), k)
            weights = weights - out[i,]
            c2 = c2 + 1
            }
        if (c2 == length(index))
            flag = FALSE
        }
    if (flag)
        stop('No matrix found. Try again.')
    final <- cbind(ind_names, as.data.frame(out))
    names(final) <- c("ind", names(df))
    return (final)
    }

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

По сути, это в конечном итоге устанавливает вес столбца, который будет выбран, равным нулю, как только этот столбец достигнет max_col, или максимальное количество вхождений, после которого столбцы не могут иметь примерно одинаковое количество. (Я позаимствовал идею Эрча о взвешивании колонн.)

Если возникает проблема (например, нельзя выбрать столбец для следующей строки, которая имеет weight>0), то процесс перезапускается, максимум до max_iter, но проходит в другом порядке строки.

Основным недостатком этого является необходимость многократно повторять все строки. Я не уверен, как обойти это, учитывая ваши ограничения. Так что, если у вас действительно большой фрейм данных, вы можете увидеть много времени на вычисления. Но в предоставленном вами наборе данных функция возвращает матрицу обычно всего за один проход, не более чем за несколько.

Answer 3

Если вам нужен случайный год, равный 1 для каждого человека, то вот метод dplyr / tidyr:

> df <- data.frame(Ind   = c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k"),
+                  Year1 = c(1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0), 
+                  Year2 = c(0, 0, 1, 1, 1, 0, 0, 1, 0, 1, 0), 
+                  Year3 = c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1), 
+                  Year4 = c(0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1))
> 
> year.weights <- df %>% 
+   gather(Year, Obs, -Ind) %>% 
+   group_by(Year) %>% 
+   summarize(wt = sum(Obs)) %>% 
+   ungroup
> 
> year.weights
# A tibble: 4 x 2
  Year     wt
  <chr> <dbl>
1 Year1     7
2 Year2     5
3 Year3     7
4 Year4     7
> 
> 
> df %>% 
+   gather(Year, Obs, -Ind) %>%
+   filter(Obs == 1) %>% 
+   left_join(year.weights, by = "Year") %>% 
+   group_by(Ind) %>% 
+   sample_n(1, weight = 1 / wt) %>% 
+   select(-wt) %>% 
+   spread(Year, Obs) %>% 
+   ungroup
# A tibble: 11 x 5
   Ind   Year1 Year2 Year3 Year4
   <fct> <dbl> <dbl> <dbl> <dbl>
 1 a         1    NA    NA    NA
 2 b        NA    NA     1    NA
 3 c        NA     1    NA    NA
 4 d         1    NA    NA    NA
 5 e        NA    NA     1    NA
 6 f         1    NA    NA    NA
 7 g        NA    NA    NA     1
 8 h        NA    NA    NA     1
 9 i        NA    NA    NA     1
10 j        NA     1    NA    NA
11 k        NA    NA    NA     1

Answer 4

Здесь решение, заменяющее НС случайным образом 3 года из 4 на каждого субъекта

for (i in 1:dim(df)[1]){
    df[i,c(sample(2:5,3))]<-NA
    }