Переоценка предметов с помощью ключа подсчета очков

У меня есть набор данных, по которым респондентам задавался ряд вопросов, каждый с пятью вариантами ответов (например, 1:5). Учитывая эти пять вариантов, у меня есть ключ оценки для каждого вопроса, где некоторые ответы дают полные баллы (например, 2), другие — полбалла (1), а третьи — отсутствие баллов (0). Таким образом, кадр данных представляет собой n (людей) x k (вопросов), а ключ оценки представляет собой матрицу k (вопросов) x m (ответов).

Что я пытаюсь сделать, так это программно создать новый набор данных с переоцененными элементами. Пробный набор данных:

x <- sample(c(1:5), 50, replace = TRUE)
y <- sample(c(1:5), 50, replace = TRUE)
z <- sample(c(1:5), 50, replace = TRUE)
dat <- data.frame(cbind(x,y,z)) # 3 items, 50 observations (5 options per item)
head(dat)
  x y z
1 3 1 2
2 2 1 3
3 5 3 4
4 1 4 5
5 1 3 4
6 4 5 4

# Each option is scored 0, 1, or 2:
key <- matrix(sample(c(0,0,1,1,2), size = 15, replace = TRUE), ncol=5)
key
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    0    0    1    2
[2,]    2    1    1    1    2
[3,]    2    2    1    1    2

person Twitch_City    schedule 02.10.2014    source источник
comment
Почему вы используете data.frame(cbind(.)), а не только data.frame(.). Первое — плохая практика, особенно если связываемые векторы относятся к разным типам.   -  person A5C1D2H2I1M1N2O1R2T1    schedule 02.10.2014
comment
Хорошая точка зрения! cbind() здесь не нужен.   -  person Twitch_City    schedule 02.10.2014


Ответы (3)


Некоторые другие варианты, в первую очередь с использованием Map:

data.frame(Map( function(x,y)  key[y,x], dat, seq_along(dat) ))

#  x y z
#1 0 2 2
#2 0 2 1
#3 2 1 1
#4 0 1 2
#5 0 1 1
#6 1 2 1

Во-вторых, используя матричную индексацию на key:

newdat <- dat
newdat[] <- key[cbind( as.vector(col(dat)), unlist(dat) )]
newdat

#  x y z
#1 0 2 2
#2 0 2 1
#3 2 1 1
#4 0 1 2
#5 0 1 1
#6 1 2 1

Все было бы еще проще, если бы вы указали key как list:

key <- list(x=c(0,0,0,1,2),y=c(2,1,1,1,2),z=c(2,2,1,1,2))
data.frame(Map("[",key,dat))

#  x y z
#1 0 2 2
#2 0 2 1
#3 2 1 1
#4 0 1 2
#5 0 1 1
#6 1 2 1
person thelatemail    schedule 02.10.2014
comment
Может я что-то упустил, но вообще как определяется ключ оценки? - person Rich Scriven; 02.10.2014
comment
@RichardScriven - это четко не указано. Каждая строка key — это вопрос, а каждый столбец — это ответ (1–5). Возвращаемое значение является содержимым ячейки. - person thelatemail; 02.10.2014
comment
Да, в этом примере я просто случайным образом сгенерировал ключ (вторая часть кода в вопросе). На самом деле, ключ будет основываться на соглашении об оценке экспертов (при этом >50% экспертов согласны с тем, что вариант получает значение 2, 5-49% экспертов соглашаются с получением значения 1, а варианты поддерживаются менее чем 5% времени, получая значение 0). Затем это будет использоваться в модели ответа с частичной кредитной оценкой через mirt. - person Twitch_City; 02.10.2014

Для потомков я обсуждал этот вопрос с другом, который предложил другой подход. Преимущество этого заключается в том, что он по-прежнему использует mapvalues() для переоценки, но не требует цикла for, вместо этого использует «от» в sapply для индексации.

library(plyr)
scored <- sapply(1:ncol(raw), function(x, dat, key){
  mapvalues(dat[,x], from = 1:ncol(key), to = key[x,])    
}, dat = dat, key = key)
person Twitch_City    schedule 02.10.2014
comment
Технически sapply — это цикл for, только слегка оптимизированный :-) - person A5C1D2H2I1M1N2O1R2T1; 02.10.2014

Мой текущий рабочий подход заключается в использовании 1) mapvalues, который находится внутри package:plyr, чтобы выполнять тяжелую работу: требуется изменить вектор данных и два дополнительных параметра «из», которые являются исходными данными (здесь 1: 5), и «в», или во что мы хотим преобразовать данные; и 2) Цикл for с обозначением индекса, в котором мы циклически просматриваем доступные вопросы, извлекаем вектор, относящийся к каждому, используя текущее значение цикла, и используем его для выбора правильной строки из нашего ключа оценки.

library(plyr)
newdat <- matrix(data=NA, nrow=nrow(dat), ncol=ncol(dat))
for (i in 1:3) {
    newdat[,i] <- mapvalues(dat[,i], from = c(1,2,3,4,5), 
                            to = c(key[i,1], key[i,2], key[i,3], key[i,4], key[i,5]))
}
head(newdat)
     [,1] [,2] [,3]
[1,]    0    2    2
[2,]    0    2    1
[3,]    2    1    1
[4,]    0    1    2
[5,]    0    1    1
[6,]    1    2    1

Я очень доволен этим решением, но если у кого-то есть лучшие подходы, я бы хотел их увидеть!

person Twitch_City    schedule 02.10.2014