如何为每个试验有效地去除异常值 [英] How to remove outliers efficiently for each trial
问题描述
我是R的新手，所以我只知道如何编写循环，但是我绝对认为有一种更有效的方法来执行我要执行的操作.
I'm new to R so all I know is how to write for loops but I definitely think there is a more efficient way to do what I am trying to do.
这是我现在拥有的代码:
Here's the code I have now:
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
我的计算机无法处理此代码. 任何建议都欢迎！
My computer cannot handle this code. Any suggestion is welcomed!
推荐答案
这可能会满足您的大部分需求.我不理解您问题的rbind部分:
This might do most of what you want. I did not understand the rbind part of your question:
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
这是使用aggregate的解决方案:
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)
这是使用ave的解决方案:
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)
这是使用dplyr的解决方案，与Dave2e的dplyr解决方案略有不同.他可能更好，因为在发布此答案之前我从未使用过dplyr.
Here is a solution using dplyr that differs a little from the dplyr solution by Dave2e. His is probably better, as I have never used dplyr until posting this answer.
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
这是使用data.table的解决方案.使用data.table可能有更好的解决方案.我想我在发布此答案之前只使用过一次data.table.
Here is a solution using data.table. There are probably better solutions using data.table. I think I only used data.table once before posting this answer.
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
这篇关于如何为每个试验有效地去除异常值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
