Блог

У меня есть набор данных, в котором 500 человек случайным образом отвечают на 5 вопросов из пула из 275 вопросов по шкале 1-5.

 library(dplyr)
set.seed(13)

df <- tibble(id = rep(1:500, 5), 
       q = sample.int(n = 275, size = max(id)*5, replace = T),
       ans = sample.int(n = 5, size = max(id)*5, replace = T))

  

Моя задача состоит в том, чтобы для каждого человека случайным образом выбрать один из 5 ответов (из тех, на которые тоже ответил кто-то другой) и сравнить его со случайно выбранным другим человеком, который ответил на тот же вопрос. Если два ответа совпадают, я отмечу его как true, а если нет, я отмечу его как false.

Я подумал о том, чтобы подойти к этому, назначив каждому выбранный вопрос на основе тех вопросов, на которые ответили более одного человека:

 sampled_q <- 
df %>%
  group_by(q) %>% 
  mutate(n_times_answer = n()) %>% 
  filter(n_times_answer >= 2) %>% 
  group_by(id) %>% 
  sample_n(1) %>% 
  transmute(id, q, assigned = T)

df %>%
  left_join(sampled_q)
  

но отсюда я не знаю, как подойти к проверке. Это также неэффективно, потому что, как только я проверяю ответ одного человека, я проверяю два ответа, чтобы технически я мог отметить T / F для двух человек, хотя эффективность не является для меня приоритетом.

Я также рассмотрел возможность изменения моих данных:

 df %>%  
  pivot_wider(id_cols = id, 
              names_from = q,
              values_from = ans) %>% 
  unnest(everything())
  

но я обнаружил, что это медленно, и я тоже застрял здесь.

Любая помощь будет оценена.

Выберите 1 правильный вопрос от каждого ответчика, затем присоедините его обратно df .

 df %>%
  group_by(q) %>%
  filter(n_distinct(id) > 1) %>% # Keep only questions that have more than one answerer
  group_by(id) %>%
  sample_n(1) %>% # Keep only one question from each answerer
  inner_join(df, by = "q") %>% # Join it back on the main table to identify other answers to the same question
  filter(id.x != id.y) %>% # Don't include answers from the same answerer
  group_by(id.x) %>%
  sample_n(1) %>% # Keep only one other answer
  mutate(matched = ans.x == ans.y) # Check if the answers matched
#> # A tibble: 500 x 6
#> # Groups:   id.x [500]
#>     id.x     q ans.x  id.y ans.y matched
#>    <int> <int> <int> <int> <int> <lgl>  
#>  1     1   175     3   106     3 TRUE   
#>  2     2    15     5   117     4 FALSE  
#>  3     3   256     4   366     3 FALSE  
#>  4     4   268     4   194     4 TRUE   
#>  5     5   161     3   485     5 FALSE  
#>  6     6   100     1   390     4 FALSE  
#>  7     7   248     5   307     2 FALSE  
#>  8     8   126     5   341     4 FALSE  
#>  9     9    65     2    93     2 TRUE   
#> 10    10    48     1   461     5 FALSE  
#> # … with 490 more rows