#r #mechanicalturk
#r #mechanicalturk
Вопрос:
У меня есть несколько идей, как с этим справиться, но я ожидаю, что ГУРУ смогут придумать что-нибудь получше. Я отправил кучу строк для ввода в Mechanical Turk. Мне нужна была одна строка из таблицы, и у меня было поле, в которое я попросил их ввести значения строки, разделенные запятыми. Затем в R я разделил это на strsplit, и теперь я сравниваю результаты записей нескольких теркеров.
Распространенной схемой является то, что один Теркер пропустит одну запись, отбрасывая остальные записи на единицу. Итак, задача состоит в том, чтобы знать, куда поместить пропущенное значение. Предположим, что они пропускают ввод только одной записи (у меня есть код проверки ошибок для подтверждения этого), и что я, возможно, получил до 3 копий из каждой строки таблицы (таким образом, может быть 1-2 нужной длины и 1-2 слишком коротких. Записи примерно такого размера, как показано ниже, и у меня их всего около 50, поэтому вычислительная эффективность не является первостепенной. Предположим, что самая длинная запись имеет надлежащую длину.
Вот пример одной такой строки (сохраненной в виде списка, где каждый элемент является репликацией другим обработчиком):
tt <- list(structure(c(4, 4, 5, 7, 9, 13, 15, 18, 20, 22, 24,
27, 30, 32, 35, 37, 41, 43, 46, 48, 51, 54, 57, 60, 63), .Dim = c(25L,
1L)), structure(c(4, 4, 5, 7, 9, 11, 13, 15, 18, 20, 22, 25,
27, 30, 32, 35, 37, 40, 43, 46, 48, 51, 54, 57, 60, 63), .Dim = c(26L,
1L)), structure(c(4, 4, 5, 7, 9, 11, 13, 15, 19, 20, 22, 25,
27, 30, 32, 35, 37, 42, 43, 46, 48, 51, 54, 57, 61, 63), .Dim = c(26L,
1L)))
lengths <- sapply(tt,length)
longs <- simplify2array(tt[lengths==max(lengths)],FALSE)
shorts <- simplify2array(tt[lengths==max(lengths)-1],FALSE)
Алгоритмы, которые я рассмотрел, являются:
- Создание
max(lengths)перестановок с NA в каждом отдельном возможном месте и одновременное сравнение их с 1-2 значениями соответствующей длины, используя некоторую оценку общего отклонения. - Перебираю каждый элемент и сравниваю с 1-2 элементами соответствующей длины, пока не нахожу неточное совпадение. Затем решите, насколько велика разница по сравнению со всеми последующими различиями с NA или нет. Например. если они совпадают с 5-й записью, но включение NA в 5-ю запись по-прежнему оставляет остальные значения меньше, чем разница в 5-й записи, продолжайте движение вниз по векторам.
Любопытно, как все это реализуют. Мне трудно избегать циклов и писать это элегантным способом. Возможно, что-то вроде filter могло бы помочь.
Примеры проблемного ввода и желаемого вывода
Проблемный ввод (отсутствует одно значение; нет опечаток в других значениях)
> tt1 <- list(c(4, 4, 7, 9, 11), c(4, 4, 5, 7, 9, 11), c(4, 4, 5, 7, 9,
11))
> tt1
[[1]]
[1] 4 4 7 9 11
[[2]]
[1] 4 4 5 7 9 11
[[3]]
[1] 4 4 5 7 9 11
Желаемый результат
> tt1
[,1] [,2] [,3]
1 4 4 4
2 4 4 4
3 NA 5 5
4 7 7 7
5 9 9 9
6 11 11 11
Problematic input (missing value a typo in another value)
> tt2 <- list(c(4, 4, 7, 9, 11), c(4, 3, 5, 7, 9, 11), c(4, 4, 5, 7, 9,
11))
> tt2
[[1]]
[1] 4 4 7 9 11
[[2]]
[1] 4 3 5 7 9 11
[[3]]
[1] 4 4 5 7 9 11
Desired output
> tt2[[1]][4:6] <- tt2[[1]][3:5]
> tt2[[1]][3] <- NA
> simplify2array(tt2,FALSE)
[,1] [,2] [,3]
[1,] 4 4 4
[2,] 4 3 4
[3,] NA 5 5
[4,] 7 7 7
[5,] 9 9 9
[6,] 11 11 11
Другие варианты опечаток следует терпимо переносить. Обратите внимание, что векторы обычно увеличиваются (вы могли бы рассматривать их как монотонно увеличивающиеся с шумом). Так что, если кто-то ошибочно принимает 7 за 4, это, вероятно, опечатка. Обратите также внимание, что для большинства я выполнил только 2 репликации, поэтому не будет никакого способа придать одному не пропущенному значению больше достоверности, чем любому другому не пропущенному значению. Придется взглянуть на шаблон в целом или, по крайней мере, воспользоваться тем фактом, что они обычно увеличиваются.
Полный фрейм данных
Каждый из приведенных выше примеров tt представляет собой все записи totalTime для данного уровня изображения футов в data.frame ниже. Это весь набор данных. Обратите внимание, что общее количество записей потенциально изменяется между image группами. Это значение известно заранее, или вы могли бы просто получить его из максимального числа записей.
dat <- structure(list(feet = c(1, 2, 3, 3, 1, 1, 7, 7, 8, 9, 9, 1, 1,
2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6,
6, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 6, 6, 7, 7, 8, 8, 9, 10, 10
), TotalTime = c("4,3,4,6,6,10,12,14,16,18,20,22,25,28,30,32,34,36,41,44,46,49,51,55,58",
"4,4,5,7,9,11,13,15,18,20,22,25,27,30,32,35,37,41,43,46,48,51,54,57,60,63",
"3,4,6,8,11,13,15,17,20,22,25,27,32,34,38,39,41,44,47,49,52,55,58,61,64,67",
"3,4,6,8,11,13,15,17,20,22,25,27,32,34,36,39,41,44,47,49,52,55,58,61,64,67",
"4,3,4,6,8,20,22,24,26,28,30,31,34,36,38,40,42,44,46,48,50,52,54,56,58,60",
"4,3,4,6,8,10,12,14,16,18,20,22,25,28,30,32,34,38,41,44,46,49,51,55,58",
"4,4,4,7,10,15,18,21,24,29,32,35,38,43,47,52,56,60,63,67,72,76,82,84",
"4,4,4,7,10,15,18,21,24,29,32,35,38,43.47,52,56,60,63,67,72,76,82,84",
"4,3,5,8,14,16,20,24,27,31,34,37,42,46,49,55,59,64,68,73,77,83,89,91",
"4,4,6,9,15,18,22,25,28,32,36,40,44,49,53,59,63,68,74,80,85,93,94",
"4,4,6,9,15,18,22,25,28,32,36,40,44,49,53,59,63,68,74,80,85,88,93,94",
"4,3,4,6,8,10,12,14,16,18,20,22,25,28,30,32,34,36,41,44,46,49,51,55,58",
"4,3,4,6,8,10,12,14,16,18,20,22,25,28,30,32,34,36,38,41,44,46,49,51,55,58",
"4,4,5,7,9,11,13,15,18,20,22,25,27,31,32,35,37,41,43,46,48,51,54,57,60,63",
"4,4,5,7,9,11,13,15,18,20,22,25,27,30,32,35,37,41,43,46,48,51,54,57,60,63",
"3,4,6,8,11,13,15,17,20,22,25,27,32,34,38,39,41,44,47,49,52,55,58,61,64,67",
"3,4,6,8,11,13,15,17,20,22,25,27,32,34,36,39,41,44,47,49,52,55,58,61,64,67",
"3,5,7,9,12,14,16,19,22,24,29,31,34,36,38,41,44,47,50,53,58,61,64,67,69,72",
"3,5,7,9,12,14,16,19,22,24,29,31,34,36,38,41,44,47,50,53,58,61,64,67,69,72",
"4,6,8,11,13,15,19,21,25,28,30,33,36,38,41,44,49,52,55,58,61,65,68,71,75,79",
"4,6,8,11,13,15,19,21,25,28,30,33,36,38,41,44,49,52,55,58,61,65,68,71,75,79",
"4,6,9,11,14,17,21,24,27,30,33,35,38,42,45,49,52,55,58,63,67,70,73,78,82,85",
"4,6,9,11,14,17,21,24,27,30,33,35,36,42,45,49,52,55,58,63,67,70,73,78,82,85",
"2,4,6,9,11,13,16,16,20,23,24,26,28,29,31,33,35,37,39,40,42,43,45,47,52",
"2,4,6,9,11,13,16,18,20,21,23,24,26,28,29,31,33,35,37,39,40,42,43,45,47,52",
"2,5,7,11,12,14,17,19,21,22,24,26,28,29,31,35,36,39,41,42,44,46,48,50,52,54",
"2,5,7,11,12,14,17,19,21,22,24,26,28,29,31,35,36,39,41,42,44,46,48,50,52,54",
"4,6,9,11,13,16,18,20,22,24,27,29,31,32,35,37,39,41,43,45,46,49,51,53,55,57",
"4,6,9,11,13,16,18,20,22,24,27,29,31,32,35,37,39,41,43,45,46,49,51,53,55,57",
"6,7,10,13,15,18,20,23,24,28,30,32,34,37,39,41,43,45,47,49,54,57,59,61,63",
"6,7,10,13,15,18,20,23,24,26,28,30,32,34,37,39,41,43,45,47,49,54,57,59,61,63",
"6,8,10,14,16,19,21,23,25,28,30,32,36,39,41,43,45,47,49,52,54,57,59,61,63,65",
"6,8,10,14,16,19,21,23,25,28,30,32,36,39,41,43,45,47,49,52,54,57,59,61,63,65",
"7,9,12,14,18,20,23,24,27,31,33,35,38,40,43,45,47,49,51,55,58,60,62,65,67,69",
"7,9,12,14,18,20,23,24,27,31,33,35,38,40,43,45,47,49,51,55,58,60,62,65,67,69",
"4,3,5,7,10,13,17,20,23,26,29,33,36,40,43,48,51,55,60,64,67,72,75,77",
"4,3,5,7,10,13,17,20,23,26,29,33,36,40,43,48,51,55,60,64,67,72,75,77",
"4,4,4,7,10,15,18,21,24,29,32,35,38,43,47,52,56,60,63,67,72,76,82,84",
"4,4,4,7,10,15,18,21,24,29,32,35,38,43,47,52,56,60,63,67,72,76,82,84",
"4,3,5,8,14,16,20,24,27,31,34,37,42,46,49,55,59,64,68,73,77,83,89,91",
"4,3,5,8,14,16,20,24,27,31,34,37,42,46,49,55,59,64,68,73,77,83,89,91",
"4,4,6,9,15,18,22,25,28,32,36,40,44,49,53,59,63,68,74,80,85,88,93,94",
"4,4,6,9,15,18,22,25,28,32,36,40,44,49,53,59,63,68,74,80,85,88,93,94",
"0,0,0,1,1,1,3,3,3,5,5,5,6,6,7,7,8,8,9,10,11,10,11,11", "0,0,0,1,1,1,3,3,3,5,5,6,6,7,7,8,8,9,10,11,10,11,11",
"6,4,7,10,13,16,20,22,25,27,30,32,35,38,43,45,48,52,54,57,60,62,64,67",
"6,4,7,10,13,16,20,22,25,27,30,32,35,38,43,45,48,52,54,57,60,62,64,67",
"6,4,7,10,14,19,21,23,26,28,33,36,39,42,45,47,50,53,56,60,62,65,69,70",
"6,4,7,10,14,19,21,23,26,28,33,36,39,42,45,47,50,53,56,60,62,65,69,70",
"2,5,9,12,14,20,21,24,29,32,34,37,41,44,46,50,53,59,62,65,68,72,75,76",
"2,5,9,12,14,20,21,24,29,32,34,37,41,44,46,50,53,59,62,65,68,72,75,76",
"2,5,9,13,17,20,24,27,30,33,37,42,45,48,52,55,58,62,65,67,72,75,78,80",
"3,6,10,15,18,23,25,26,28,32,36,40,43,47,50,53,58,61,65,67,70,75,78,83,86",
"3,6,10,15,18,23,25,28,32,36,40,43,47,50,53,58,61,65,67,70,75,78,83,86"
), image = c(1, 1, 1, 1, 3, 3, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 4, 4, 4, 4, 4, 4, 4, 4, 4)), .Names = c("feet",
"TotalTime", "image"), row.names = c(1L, 2L, 3L, 4L, 5L, 6L,
7L, 8L, 9L, 10L, 11L, 14L, 15L, 16L, 17L, 19L, 20L, 22L, 23L,
24L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L,
38L, 40L, 41L, 42L, 43L, 44L, 45L, 46L, 47L, 49L, 50L, 51L, 53L,
54L, 55L, 56L, 57L, 58L, 59L, 61L, 62L, 63L), class = "data.frame")
Комментарии:
1. Как должен выглядеть результат алгоритма?
2. А, хорошая мысль. Результатом должна быть матрица со столбцами длины (tt) и строками максимальной длины (lengths): каждый столбец является элементом tt, только с вставленным при необходимости пропущенным значением. Это происходит внутри вызова ddply, и в конечном итоге я выполню некоторые другие проверки наиболее вероятных строк и верну один столбец в качестве результата.
3. не уверен, правильно ли я понимаю, чего вы хотите, но похоже ли это?
as.matrix(t(laply(tt, function(x) c(x, rep(NA, max(sapply(tt, length)) - length(x))))))4. @kohske Это здорово, но работает только в том случае, если пропущенное значение находится в последнем месте. Я собираюсь пояснить это некоторыми примерами.
5. @gsk3 тогда все столбцы с максимальной длиной (здесь 2-й и 3-й столбцы) идентичны?
Ответ №1:
Вот решение, которое должно быть читаемым. Без сомнения, его можно свернуть на меньшее количество строк кода:
desiredLength <- function(x){
len <- sapply(x, length)
max(len)
}
insertNA <- function(x, position=1){
c(x[seq_along(x) < position], NA, x[seq_along(x) >= position])
}
fixLength <- function(x, position=1){
dlen <- desiredLength(x)
sapply(x, function(zz) if(length(zz) < dlen) insertNA(zz, position) else zz)
}
objectiveFunction <- function(x){
sum(apply(x, 1, function(z)length(unique(z))))
}
findMinObjective <- function(x){
pos <- NA
obj <- Inf
for(i in 1:desiredLength(x)){
z <- objectiveFunction(fixLength(x, position=i))
if(z < obj){
obj <- z
pos <- i
}
}
fixLength(x, pos)
}
Результаты:
> findMinObjective(tt1)
[,1] [,2] [,3]
[1,] 4 4 4
[2,] 4 4 4
[3,] NA 5 5
[4,] 7 7 7
[5,] 9 9 9
[6,] 11 11 11
> findMinObjective(tt2)
[,1] [,2] [,3]
[1,] 4 4 4
[2,] 4 3 4
[3,] NA 5 5
[4,] 7 7 7
[5,] 9 9 9
[6,] 11 11 11
Ответ №2:
Я надеюсь, что это поможет:
f <- function(tt) {
len <- (sapply(tt, length))
tar <- rowMeans(do.call("cbind", tt[len == max(len)]))
tt[len < max(len)] <-
lapply(tt[len < max(len)],
function(x) {
r <- lapply(combn(max(len), max(len)-length(x)),
function(i) {z <- numeric(max(len)); z[i] <- NA; z[!is.na(z)] <- x; z})
r[[which.min(sapply(r, function(x) sum((x - tar)^2, na.rm = T)))]]
})
simplify2array(tt,FALSE)
}
затем,
> f(tt)
[,1] [,2] [,3]
[1,] 4 4 4
[2,] 3 4 4
[3,] 4 5 5
... snip ...
[24,] 55 57 57
[25,] 58 60 61
[26,] NA 63 63
> f(tt1)
[,1] [,2] [,3]
[1,] 4 4 4
[2,] 4 4 4
[3,] NA 5 5
[4,] 7 7 7
[5,] 9 9 9
[6,] 11 11 11
> f(tt2)
[,1] [,2] [,3]
[1,] 4 4 4
[2,] 4 3 4
[3,] NA 5 5
[4,] 7 7 7
[5,] 9 9 9
[6,] 11 11 11
и вот пример для ваших полных данных:
dlply(dat, .(feet, image), function(x) f(lapply(strsplit(x$TotalTime, ","), as.numeric)))
похоже, работает хорошо.