Umgang mit fehlenden Werten bei unbekanntem Standort

Question

Ich habe ein paar Ideen, wie man damit umgehen kann, aber ich gehe davon aus, dass sich die guRus noch etwas Besseres einfallen lassen können. Ich habe eine Reihe von Zeilen bei Mechanical Turk eingegeben. Ich brauchte eine einzelne Zeile aus einer Tabelle, und ich hatte ein Feld, in das ich sie bat, die Werte der Zeile durch Kommas getrennt einzugeben. In R habe ich dann strsplit verwendet, und ich vergleiche jetzt die Ergebnisse der Eingaben mehrerer Türken.

Es kommt häufig vor, dass ein Turker einen einzigen Eintrag übersehen hat, wodurch die übrigen Einträge um einen Eintrag verfälscht werden. Die Herausforderung besteht also darin, zu wissen, wo der fehlende Wert einzuordnen ist. Nehmen wir an, dass nur ein einziger Eintrag fehlt (ich habe einen Fehlerprüfungscode, um dies zu bestätigen) und dass ich bis zu drei Wiederholungen aus jeder Tabellenzeile erhalten habe (es könnte also 1-2 mit der richtigen Länge geben und 1-2, die zu kurz sind. Die Einträge haben in etwa die unten angegebene Größe, und ich habe nur etwa 50, so dass die Effizienz der Berechnung nicht im Vordergrund steht. Gehen Sie davon aus, dass der längste Eintrag die richtige Länge hat.

Hier ist ein Beispiel für eine solche Zeile (gespeichert als Liste, wobei jedes Element eine Replikation durch einen anderen Turker ist):

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)

Folgende Algorithmen habe ich in Betracht gezogen:

• Erstellen von max(lengths) Permutationen mit der NA an jeder einzelnen möglichen Stelle und gleichzeitiger Vergleich mit den 1-2 Permutationen von angemessener Länge unter Verwendung einer Schätzung der Gesamtabweichung.
• Ich durchlaufe jedes Element und vergleiche es mit den 1-2 Elementen der entsprechenden Länge, bis ich eine nicht exakte Übereinstimmung finde. Dann entscheide ich, wie groß der Unterschied im Vergleich zu allen nachfolgenden Unterschieden mit der NA ist oder nicht. Wenn sie z. B. bis zum 5. Eintrag übereinstimmen, aber durch das Einfügen von NA in den 5. Eintrag der Rest immer noch um mehr als die Differenz im 5.

Ich bin neugierig, wie jeder dies umsetzen würde. Ich habe eine harte Zeit zu vermeiden Schleifen und schreiben dies in einer eleganten Weise. Möglicherweise etwas wie filter könnte helfen.

Beispiele für problematischen Input und gewünschten Output

Problematische Eingabe (ein Wert fehlt; keine Tippfehler in anderen Werten)

> 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

Gewünschte Leistung

> 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

Problematische Eingabe (fehlender Wert + Tippfehler in einem anderen Wert)

> 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

Gewünschte Leistung

> 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

Andere Variationen von Tippfehlern sollten gnädig toleriert werden. Beachten Sie, dass die Vektoren im Allgemeinen ansteigend sind (man könnte sie als monoton steigend mit Rauschen betrachten). Wenn also jemand eine 7 mit einer 4 verwechselt, ist das wahrscheinlich ein Tippfehler. Beachten Sie auch, dass ich für die meisten nur 2 Wiederholungen durchgeführt habe, so dass es keine Möglichkeit gibt, einem nicht fehlenden Wert mehr Glaubwürdigkeit zu verleihen als einem anderen nicht fehlenden Wert. Man muss das gesamte Muster betrachten oder zumindest die Tatsache ausnutzen, dass sie im Allgemeinen ansteigen.

Vollständiger Datenrahmen

Jedes der obigen tt-Beispiele sind alle TotalTime-Einträge für eine bestimmte Fuß-Bild-Ebene in dem unten stehenden data.frame. Dies ist der gesamte Datensatz. Beachten Sie, dass sich die Gesamtzahl der Einträge möglicherweise zwischen image Gruppen. Dieser Wert ist im Voraus bekannt, oder Sie könnten ihn einfach aus dem Maximum der Einträge ermitteln.

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

Answer 1

Ich hoffe, dies wird Ihnen helfen:

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

dann,

> 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

und hier ist ein Beispiel für Ihre vollständigen Daten:

dlply(dat, .(feet, image), function(x) f(lapply(strsplit(x$TotalTime, ","), as.numeric)))

scheint gut zu funktionieren.

Answer 2

Hier ist eine Lösung, die darauf abzielt, lesbar zu sein. Sie lässt sich zweifellos auf eine geringere Anzahl von Codezeilen zusammenfassen:

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

Die Ergebnisse:

> 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