Блог

Согласно следующей таблице, у меня много разных учителей (10,11,12, …) с разными идеями (1,2, … например, 1: Очень хорошо, 2: Хорошо, …) каждого класса (1,2,3, …). Некоторые учителя не имеют никакого представления о некоторых классах.

 class  Teacher-code  Opinion
     1   12            1
     1   13            1
     1   14            1
     2   11            3
     2   13            1
     3   10            1
     3   11            2
     3   12            1
     3   13            1
 

Это образец моей таблицы, но у меня много записей. Я хочу иметь симметричную матрицу учителей с подсчетами их одинаковых представлений о классах. например, учитель 12 и 13 имеют одинаковую идею в классе 1 и 3, тогда их элементы пересечения равны 2. Или коды учителей 14 и 13 имеют только одну и ту же идею о первом классе. Я хочу получить следующую матрицу:

      [10] [11] [12] [13] [14]
[10]    0    0    1    1    0
[11]    0    0    0    0    0
[12]    1    0    0    2    1
[13]    1    0    2    0    1
[14]    0    0    1    1    0
 

Это базовое решение R, основанное на общем подходе, используемом для поиска общих строк между фреймами данных. Возможно, это может быть полезно.

Создайте функцию, которая найдет совпадение в вашем фрейме данных между преподавателями, которые разделяют другие общие значения в определенных столбцах (в данном случае, class и Opinion ). С merge помощью вы можете определить перекрытие и nrow подсчитать перекрывающиеся строки.

С помощью outer вы можете сгенерировать матрицу всех учителей. Функция, переданная продукту, должна быть векторизована.

 the_teachers <- sort(unique(df$Teacher_code))

get_num_classes <- function(x, y) {
  nrow(
    merge(
      df[df$Teacher_code == x, c("class", "Opinion")], 
      df[df$Teacher_code == y, c("class", "Opinion")]
    )
  )
}

mat <- outer(the_teachers, the_teachers, Vectorize(get_num_classes))
diag(mat) <- 0
dimnames(mat) <- list(the_teachers, the_teachers)
mat
 

Вывод

    10 11 12 13 14
10  0  0  1  1  0
11  0  0  0  0  0
12  1  0  0  2  1
13  1  0  2  0  1
14  0  0  1  1  0
 

Редактировать: основываясь на комментарии, есть интерес к определению доли (пары учителей, разделяющих одинаковые мнения в одном классе) / (пары учителей, разделяющие один и тот же класс). Основываясь на той же логике, вы можете изменить функцию, как показано ниже. Отдельное слияние определит количество учителей, совместно использующих один и тот же класс. Если это число не равно нулю, оно будет определять количество мнений, разделяемых парой учителей. Если нет общих классов, функция просто вернет ноль. В зависимости от размера данных и согласованности между преподавателями это может быть оптимизировано дополнительно.

 get_num_classes <- function(x, y) {
  same_class <- nrow(
    merge(
      df[df$Teacher_code == x, "class", drop = F], 
      df[df$Teacher_code == y, "class", drop = F]
    )
  )
  if (same_class != 0) {
    same_opinion <- nrow(
      merge(
        df[df$Teacher_code == x, c("class", "Opinion")], 
        df[df$Teacher_code == y, c("class", "Opinion")]
      )
    )
    return(same_opinion / same_class)
  } else {
    return(0)
  }
}
 

Вот базовый параметр R, определяющий пользовательскую функцию f , где aggregate pmin vecsets::vintersect применяются:

 library(vecsets)
f <- function(df) {
  u <- aggregate(. ~ Teacher_code, df, I)
  res <- do.call(
    pmin,
    lapply(
      u[c("class", "Opinion")],
      function(x) outer(x, x, FUN = function(...) lengths(Vectorize(vintersect)(...)))
    )
  )
  `dimnames<-`(`diag<-`(res, 0), rep(list(u[["Teacher_code"]]), 2))
}
 

и вы увидите

 > f(df)
   10 11 12 13 14
10  0  0  1  1  0
11  0  0  0  0  0
12  1  0  0  2  1
13  1  0  2  0  1
14  0  0  1  1  0
 

Я имею в виду, что это довольно отвратительный код (я уверен, что кто-то может сделать что-то лучше), но я думаю, что он дает вам нужный результат (это не домашнее задание, не так ли -.- ?). Также в будущем это упростит жизнь, если вы предоставите данные с помощью dput()

 library(dplyr)
library(tidyr)


dat <- tibble(
    class = c( 1,1,1,2,2,3,3,3,3),
    Teacher_code = c(12,13,14,11,13,10,11,12,13),
    Opinion = c(1,1,1,3,1,1,2,1,1)
)

dat2 <- complete(dat, class, Teacher_code)
classes <- unique(dat2$class)
teachers <- unique(dat2$Teacher_code)
len_teachers <- length(teachers)

mat <- matrix(nrow = len_teachers, ncol = len_teachers)

for(i in seq_along(teachers)){
    for( j in seq_along(teachers)){
        same_opinion <- 0
        for(k in classes){
            opinion_i <- dat2 %>% filter(Teacher_code == teachers[[i]] , class == k) %>% pull(Opinion)
            opinion_j <- dat2 %>% filter(Teacher_code == teachers[[j]] , class == k) %>% pull(Opinion)
            same_opinion <- same_opinion   (opinion_i == opinion_j amp; !(is.na(opinion_i) | is.na(opinion_j)))
        }
        mat[i,j] <- same_opinion
    }
}