Работа с пропущенными значениями неизвестного местоположения - PullRequest
Новая
       7

Работа с пропущенными значениями неизвестного местоположения

2 голосов
/ 11 ноября 2011

У меня есть несколько идей, чтобы справиться с этим, но я ожидаю, что guRus может еще что-то придумать. Я отправил несколько строк в Механический турок. Мне нужна была одна строка из таблицы, и у меня было поле, в которое я просил их ввести значения строки, разделенные запятыми. В R я затем strsplit это, и я сейчас сравниваю результаты нескольких записей Тюркеров.

Распространенная закономерность состоит в том, что один Туркер пропустит одну запись, отбрасывая остальные записи на одну. Таким образом, задача состоит в том, чтобы знать, где поставить недостающее значение. Предположим, что они только пропускают ввод одной записи (у меня есть код проверки ошибок, чтобы подтвердить это), и что я мог получить до 3 повторов из каждой строки таблицы (так что может быть 1-2 правильной длины, и 1-2, которые слишком короткие. Записи приблизительно имеют размер ниже, а у меня всего около 50, поэтому эффективность вычислений не имеет первостепенного значения. Предположим, что самая длинная запись имеет правильную длину.

Вот пример одной такой строки (хранящейся в виде списка, где каждый элемент является репликацией другим Turker): 

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 элементами соответствующей длины, пока не найду неточное совпадение. Затем решите, насколько велика разница по сравнению со всеми последующими различиями с НС или нет. Например. если они совпадают до 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

Проблемный ввод (пропущенное значение + опечатка в другом значении) 

> 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

Желаемый выход 

> 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")

Ответы [ 2 ]

1 голос
/ 11 ноября 2011

Вот решение, которое стремится быть читабельным.Без сомнения, он может быть свернут в меньшее количество строк кода: 

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
1 голос
/ 11 ноября 2011

Я надеюсь, что это поможет: 

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)))

выглядитработает хорошо.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...