Wie man Ausreißer für jeden Versuch effizient entfernt

Question

Ich bin neu in R, also weiß ich nur, wie man für Schleifen schreibt, aber ich denke definitiv, dass es einen effizienteren Weg gibt, das zu tun, was ich versuche.

Hier ist der Code, den ich jetzt habe:

for (i in 1:length(unique(poo$TRIAL_INDEX))) { 
zz <- subset(poo, TRIAL_INDEX==i) 
sds <- sd(zz$RIGHT_PUPIL_SIZE, na.rm = TRUE) 
avgpupil <- mean(zz$RIGHT_PUPIL_SIZE, na.rm = TRUE) 
#what im trying to do in the lines above is subset the data for every trial 
#so that I can calculate the standard deviation and average for each trial 
for (j in 1:length(zz$RIGHT_PUPIL_SIZE)) { 
if (zz$RIGHT_PUPIL_SIZE[j] > 3*sds+avgpupil | zz$RIGHT_PUPIL_SIZE[j] < avgpupil-3*sds | is.na(zz$RIGHT_PUPIL_SIZE[j])) { 
    zz$RIGHT_PUPIL_SIZE[j] <- NA_character_ 
    goo <- rbind(zz[j],goo) 
} else { 
    goo <- rbind(zz[j],goo) 
} 
} 
} 
#then I want it to replace the value in RIGHT_PUPIL_SIZE with NA if it is 
# 3 SD above or under the mean, and if it's NA. Then I bind it to a new dataframe 

Mein Computer diesen Code nicht verarbeiten kann. Jeder Vorschlag ist willkommen!

Answer 1

Dies könnte das meiste von dem tun, was Sie wollen. Ich verstand nicht, die rbind Teil Ihrer Frage:

poo <- read.table(text = ' 
    TRIAL_INDEX  RIGHT_PUPIL_SIZE 
      1     10 
      1     8 
      1     6 
      1     4 
      1     NA 
      2     1 
      2     2 
      2     NA 
      2     4 
      2     5 
', header = TRUE, stringsAsFactors = FALSE, na.strings = "NA") 


my.summary <- as.data.frame(do.call("rbind", tapply(poo$RIGHT_PUPIL_SIZE, poo$TRIAL_INDEX, 
    function(x) c(index.sd = sd(x, na.rm = TRUE), index.mean = mean(x, na.rm = TRUE))))) 

my.summary$TRIAL_INDEX <- rownames(my.summary) 

poo <- merge(poo, my.summary, by = 'TRIAL_INDEX') 

poo$RIGHT_PUPIL_SIZE <- ifelse((poo$RIGHT_PUPIL_SIZE > (poo$index.mean + 3 * poo$index.sd)) | 
           (poo$RIGHT_PUPIL_SIZE < (poo$index.mean - 3 * poo$index.sd)) | 
           is.na(poo$RIGHT_PUPIL_SIZE), NA, poo$RIGHT_PUPIL_SIZE) 

poo 

# TRIAL_INDEX RIGHT_PUPIL_SIZE index.sd index.mean 
#1   1    10 2.581989   7 
#2   1    8 2.581989   7 
#3   1    6 2.581989   7 
#4   1    4 2.581989   7 
#5   1    NA 2.581989   7 
#6   2    1 1.825742   3 
#7   2    2 1.825742   3 
#8   2    NA 1.825742   3 
#9   2    4 1.825742   3 
#10   2    5 1.825742   3 

Hier ist eine Lösung aggregate verwendet, ist:

my.summary <- with(poo, aggregate(RIGHT_PUPIL_SIZE, by = list(TRIAL_INDEX), 
        FUN = function(x) { c(index.sd = sd(x, na.rm = TRUE), 
             index.mean = mean(x, na.rm = TRUE)) })) 

my.summary <- do.call(data.frame, my.summary) 

colnames(my.summary) <- c('TRIAL_INDEX', 'index.sd', 'index.mean') 

poo <- merge(poo, my.summary, by = 'TRIAL_INDEX') 

poo$RIGHT_PUPIL_SIZE <- ifelse((poo$RIGHT_PUPIL_SIZE > (poo$index.mean + 3 * poo$index.sd)) | 
           (poo$RIGHT_PUPIL_SIZE < (poo$index.mean - 3 * poo$index.sd)) | 
           is.na(poo$RIGHT_PUPIL_SIZE), NA, poo$RIGHT_PUPIL_SIZE) 

Hier ist eine Lösung ave verwendet, ist:

index.mean <- ave(poo$RIGHT_PUPIL_SIZE, poo$TRIAL_INDEX, FUN = function(x) mean(x, na.rm = TRUE)) 
index.sd <- ave(poo$RIGHT_PUPIL_SIZE, poo$TRIAL_INDEX, FUN = function(x) sd(x, na.rm = TRUE)) 

poo <- data.frame(poo, index.mean, index.sd) 

poo$RIGHT_PUPIL_SIZE <- ifelse((poo$RIGHT_PUPIL_SIZE > (poo$index.mean + 3 * poo$index.sd)) | 
           (poo$RIGHT_PUPIL_SIZE < (poo$index.mean - 3 * poo$index.sd)) | 
           is.na(poo$RIGHT_PUPIL_SIZE), NA, poo$RIGHT_PUPIL_SIZE) 

Hier ist eine Lösung mit dplyr, die ein wenig von der dplyr Lösung von Dave2e unterscheidet. Sein ist wahrscheinlich besser, da ich nie dplyr bis zum Posten dieser Antwort benutzt habe.

library(dplyr) 
my.summary <- poo %>% 
    group_by(TRIAL_INDEX) %>% 
    summarise(index.mean = mean(RIGHT_PUPIL_SIZE, na.rm = TRUE), 
       index.sd = sd(RIGHT_PUPIL_SIZE, na.rm = TRUE)) 

my.summary 

poo <- merge(poo, as.data.frame(my.summary), by = 'TRIAL_INDEX') 


poo$RIGHT_PUPIL_SIZE <- ifelse((poo$RIGHT_PUPIL_SIZE > (poo$index.mean + 3 * poo$index.sd)) | 
           (poo$RIGHT_PUPIL_SIZE < (poo$index.mean - 3 * poo$index.sd)) | 
           is.na(poo$RIGHT_PUPIL_SIZE), NA, poo$RIGHT_PUPIL_SIZE) 

poo 

Hier ist eine Lösung mit data.table. Es gibt wahrscheinlich bessere Lösungen mit data.table. Ich denke, ich habe nur data.table einmal vor dem Posten dieser Antwort verwendet.

poo <- read.table(text = ' 
    TRIAL_INDEX  RIGHT_PUPIL_SIZE 
      1     10 
      1     8 
      1     6 
      1     4 
      1     NA 
      2     1 
      2     2 
      2     NA 
      2     4 
      2     5 
', header = TRUE, stringsAsFactors = FALSE, na.strings = "NA") 

library(data.table) 

my.summary <- data.frame(setDT(poo)[, .(index.mean = mean(RIGHT_PUPIL_SIZE, na.rm = TRUE), 
              index.sd = sd(RIGHT_PUPIL_SIZE, na.rm = TRUE)), 
        .(TRIAL_INDEX)]) 

poo <- merge(poo, my.summary, by = 'TRIAL_INDEX') 

poo$RIGHT_PUPIL_SIZE <- ifelse((poo$RIGHT_PUPIL_SIZE > (poo$index.mean + 3 * poo$index.sd)) | 
           (poo$RIGHT_PUPIL_SIZE < (poo$index.mean - 3 * poo$index.sd)) | 
           is.na(poo$RIGHT_PUPIL_SIZE), NA, poo$RIGHT_PUPIL_SIZE) 

poo 

Answer 2

Hier einige Daten Beispiel:

#dput(poo) 
poo<-structure(list(TRIAL_INDEX = structure(c(1L, 2L, 1L, 2L, 1L, 
2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L), .Label = c("A", 
"B"), class = "factor"), RIGHT_PUPIL_SIZE = c(10.2043651385866, 
20.9885863196198, NA, 199, 8.83696635172232, 18.7815785751864, 
10.3610991868418, 19.6540748580446, 8.5323332390802, 20.2930866405183, 
8.74706048647041, 17.6785303413612, 10.0699206520888, 21.359973619746, 
10.1517982308973, 18.7513452694493, 8.44732655940166, 20.5369556689887, 
8.63612148828901, 22.2712027851507)), .Names = c("TRIAL_INDEX", 
"RIGHT_PUPIL_SIZE"), row.names = c(NA, -20L), class = "data.frame") 

Verwendung zur Gruppe des dplyr Pakets und durch Versuch des Index und dann auf dem Z-Score durch die Skalierungsfunktion erstellt mutieren:

library(dplyr) 
poo<-mutate(group_by(poo, TRIAL_INDEX), z=as.numeric(scale(RIGHT_PUPIL_SIZE))) 

poo$RIGHT_PUPIL_SIZE[abs(poo$z)>2]<-NA 

Die as.numeric-Funktion ist erforderlich, um das Ergebnis von der Skalierungsfunktion zu einem einfachen Vektor zu vereinfachen.