计算R中的异常值
我有一个这样的数据框：
X
Team 01/01/2012 01/02/2012 01/03/2012 01/01/2012 01/04/2012 SD Mean
A 100 50 40 NA 30 60 80
我喜欢对每个细胞进行平均值和sd计算以计算异常值。例如，
abs(x-Mean) > 3*SD
x$count<-c(1)（如果满足上述条件，则递增此值）。
我这样做是为了检查数据集中的异常。如果我知道列名称，那么计算会更容易，但列数会有所不同。一些细胞可能含有NA。
我喜欢从每个单元格中减去平均值，我尝试了这个
x$diff<-sweep(x, 1, x$Mean, FUN='-')
似乎没有用，有什么想法吗？
5 个答案:
答案 0 :(得分：38)
使用以下方法获取您的IQR（四分位数范围）和下/上四分位数
lowerq = quantile(data)[2]
upperq = quantile(data)[4]
iqr = upperq - lowerq #Or use IQR(data)
计算温和异常值的界限：
mild.threshold.upper = (iqr * 1.5) + upperq
mild.threshold.lower = lowerq - (iqr * 1.5)
外面的任何数据点（＆gt; mild.threshold.upper或＆lt; mild.threshold.lower）这些值是一个温和的异常值
要检测极端异常值，请执行相同的操作，而是乘以3：
extreme.threshold.upper = (iqr * 3) + upperq
extreme.threshold.lower = lowerq - (iqr * 3)
外面的任何数据点（＆gt; extreme.threshold.upper或＆lt; extreme.threshold.lower）这些值是一个极端异常值
希望这有帮助
编辑：访问50％，而不是75％
答案 1 :(得分：7)
我使用@ by0＆＃39的答案创建了一个自动删除异常值的函数。这是函数和一些示例代码：
# generate 10 random numbers and 2 'outlier' numbers
testData <- c(-42,rnorm(10),42)
# show the numbers
testData
# define a function to remove outliers
FindOutliers <- function(data) {
lowerq = quantile(data)[2]
upperq = quantile(data)[4]
iqr = upperq - lowerq #Or use IQR(data)
# we identify extreme outliers
extreme.threshold.upper = (iqr * 3) + upperq
extreme.threshold.lower = lowerq - (iqr * 3)
result <- which(data > extreme.threshold.upper | data < extreme.threshold.lower)
}
# use the function to identify outliers
temp <- FindOutliers(testData)
# remove the outliers
testData <- testData[-temp]
# show the data with the outliers removed
testData
答案 2 :(得分：4)
我看到你已经问了一些关于按行做事的问题。你应该避免这种情况。 R遵循以下概念：列表示变量，行表示观察。根据这个概念优化了许多功能。如果您需要对文件进行宽输出或转置输出，则可以在写入文件之前重新排列数据。
我认为您的数据实际上看起来如问题所示，但您有多行。
df <- read.table(text="Team 01/01/2012 01/02/2012 01/03/2012 01/01/2012 01/04/2012 SD
Mean
A 100 50 40 NA 30 60 80
B 200 40 5 8 NA NA NA",check.names = FALSE,header=TRUE)
#needed because one date appears twice
df <- df[,]
#reshape the data
library(reshape2)
df <- melt(df,id="Team")
names(df)[2] <- "Date"
#remove the SD and Mean
df <- df[!df$Date %in% c("SD","Mean"),]
#function to detect outliers
outfun <- function(x) {
abs(x-mean(x,na.rm=TRUE)) > 3*sd(x,na.rm=TRUE)
}
#test if function works
outfun(c(200,rnorm(10)))
#use function over all data
df3$outlier.all <- outfun(df3$value)
#apply function for each team
library(plyr)
df3 <- ddply(df3,.(Team),transform,outlier.team=outfun(value))
结果：
Date Team value outlier.all outlier.team
1 01/01/2012 A 100 FALSE FALSE
2 01/02/2012 A 50 FALSE FALSE
3 01/03/2012 A 40 FALSE FALSE
4 01/01/2012.1 A NA NA NA
5 01/04/2012 A 30 FALSE FALSE
6 01/01/2012 B 200 FALSE FALSE
7 01/02/2012 B 40 FALSE FALSE
8 01/03/2012 B 5 FALSE FALSE
9 01/01/2012.1 B 8 FALSE FALSE
10 01/04/2012 B NA NA NA
答案 3 :(得分：0)
以下公式可用于确定哪些值是异常值：
upper.outlier.calc <- function(x.var, df){with(df, quantile(x.var, 0.75) + (1.5 * (quantile(x.var, 0.75) - quantile(x.var, 0.25))))}
lower.outlier.calc <- function(x.var, df){with(df, quantile(x.var, 0.25) - (1.5 * (quantile(x.var, 0.75) - quantile(x.var, 0.25))))}
答案 4 :(得分：0)
查看我最复杂的功能。它具有三种方法（z mad，iqr）和离群值的不同处理（删除或替换）。可以使用图表，并且可以进行黑客入侵（尝试不同的方法或阈值）
请参见示例：
set.seed(1234)
x = rnorm(10)
ez.outlier(iris,'Sepal.Length',fill='null',hack=T,cutoff=c(1,2,3),plot=T)
#' univariate outlier cleanup
#' @description univariate outlier cleanup
#' @param x a data frame or a vector
#' @param col colwise processing
#' \cr col name
#' \cr if x is not a data frame, col is ignored
#' \cr could be multiple cols
#' @param method z score, mad, or IQR (John Tukey)
#' @param cutoff abs() > cutoff will be treated as outliers. Default/auto values (i.e. if NA):
#' \cr z 95% of values fall within 1.96, qnorm(0.025,lower.tail=F), or 3
#' \cr mad 2.5, which is the standard recommendation, or 5.2
#' \cr iqr 1.5
#' \cr if multiple values specified, use the first one (an exception is hack=T, during which method and cutoff same length or scalar)
#' @param hack call mapply to try all method and cutoff (same length or scalar, ie, different methods with
#' corresponding cutoff, or same method with different cutoff).
#' @param plot boxplot and hist before and after outlier processing.
#' @param fillout how to process outlier, fill with na, mean, median (columnwise for data frame), or
#' null --> remove outlier (only for vector or df with single col specified)
#' @return returns a new data frame or vector. If hack=T, returns nothings
#' @note univariate outlier approach
#' The Z-score method relies on the mean and standard deviation of a group of data to measure central
#' tendency and dispersion. This is troublesome, because the mean and standard deviation are highly
#' affected by outliers – they are not robust. In fact, the skewing that outliers bring is one of the
#' biggest reasons for finding and removing outliers from a dataset!
#' Another drawback of the Z-score method is that it behaves strangely in small datasets – in fact,
#' the Z-score method will never detect an outlier if the dataset has fewer than 12 items in it.
#' \cr
#' \cr
#' Median absolute deviation, modified z-score. The median and MAD are robust measures of central tendency and dispersion, respectively.
#' \cr
#' \cr
#' Interquartile range method is that, like the modified Z-score method, it uses a robust measure of dispersion.
#' \cr
#' @examples
#' set.seed(1234)
#' x = rnorm(10)
#' iris %>% ez.outlier('Sepal.Length',fill='null',hack=T,plot=T)
#' @export
ez.outlier = function(x, col=NULL, method=c('z','mad','iqr'), cutoff=NA, fillout=c('na','null','mean','median'), hack=FALSE, plot=FALSE, na.rm=TRUE, print2scr=TRUE) {
# https://datascienceplus.com/rscript/outlier.R
# https://cran.r-project.org/web/packages/outliers/index.html
# https://rpubs.com/hauselin/outliersDetect
if (hack==T){
# here for programming reason, for mapply,
# cutoff could not be NULL, use NA, because length(NULL)=0, but length(NA)=1
mapply(ez.outlier,method=method,cutoff=cutoff,MoreArgs=list(x=x,col=col,hack=F,plot=plot,fillout=fillout,na.rm=na.rm,print2scr=print2scr),SIMPLIFY=F,USE.NAMES=F)
cat('Hack done! No actual data returned.\n')
return(invisible(NULL))
}
method = match.arg(method); fillout =fillout[1]; cutoff=cutoff[1]
if (!is.data.frame(x)) {
# todropna is a workaround for data frame with single col passed in
x.bak.plot = x; x.replace.na = x; oldNAs = sum(is.na(x.replace.na))
if (fillout=='na' | fillout=='todropna') {
replacement = NA
} else if (fillout=='mean') {
replacement = mean(x, na.rm=na.rm)
} else if (fillout=='median') {
replacement = median(x, na.rm=na.rm)
} else if (fillout=='null') {
replacement = NULL
}
if (method=='z'){
if(is.na(cutoff)) cutoff = qnorm(0.025,lower.tail=F)
absz = abs((x - mean(x, na.rm=na.rm))/sd(x, na.rm=na.rm))
if (!is.null(replacement)) {
x[absz > cutoff] <- replacement
} else {
# if nothing above cutoff, x is untouched
if (length(which(absz > cutoff)) > 0) {
x = x[-which(absz > cutoff)]
}
}
x.replace.na[absz > cutoff] <- NA
} else if (method=='mad'){
if(is.na(cutoff)) cutoff = 2.5
absmad <- abs((x - median(x, na.rm=na.rm))/mad(x, na.rm=na.rm))
if (!is.null(replacement)) {
x[absmad > cutoff] <- replacement
} else {
if (length(which(absmad > cutoff)) > 0) {
x = x[-which(absmad > cutoff)]
}
}
x.replace.na[absmad > cutoff] <- NA
} else if (method=='iqr'){
# https://stackoverflow.com/a/4788102/2292993
if(is.na(cutoff)) cutoff = 1.5
q1 <- quantile(x, 0.25, na.rm=na.rm)
q3 <- quantile(x, 0.75, na.rm=na.rm)
# alternatively iqr = q3-q1
iqr = IQR(x, na.rm = na.rm)
lower_bound = q1 - (iqr * cutoff)
upper_bound = q3 + (iqr * cutoff)
if (!is.null(replacement)) {
x[(x > upper_bound) | (x < lower_bound)] <- replacement
} else {
if (length(which((x > upper_bound) | (x < lower_bound))) > 0) {
x = x[-which((x > upper_bound) | (x < lower_bound))]
}
}
x.replace.na[(x.replace.na > upper_bound) | (x.replace.na < lower_bound)] <- NA
}
newNAs = sum(is.na(x.replace.na)) - oldNAs
if (print2scr) {
if (!is.null(col)) {
cat(sprintf('%-15s %5s(%.2f): %3d outliers found and %s.\n', toString(col), toupper(method), cutoff, newNAs, ifelse((is.null(replacement)|fillout=='todropna'),'REMOVED','REPLACED')))
} else {
cat(sprintf('%5s(%.2f): %3d outliers found and %s.\n', toupper(method), cutoff, newNAs, ifelse((is.null(replacement)|fillout=='todropna'),'REMOVED','REPLACED')))
}
}
if (plot){
# mar controls margin size for individual plot it goes c(bottom, left, top, right)
# oma is margin for the whole?
opar = par(mfrow=c(2, 2), oma=c(0,0,1.5,0), mar = c(2,2,1.5,0.5))
on.exit(par(opar))
boxplot(x.bak.plot, main=sprintf("With outliers (n=%d)",length(x.bak.plot)))
hist(x.bak.plot, main=sprintf("With outliers (n=%d)",length(x.bak.plot)), xlab=NULL, ylab=NULL)
boxplot(x, main=sprintf("With outliers (n=%d)",length(x.bak.plot)-newNAs))
hist(x, main=sprintf("With outliers (n=%d)",length(x.bak.plot)-newNAs), xlab=NULL, ylab=NULL)
title(sprintf("%s Outlier Check: %s(%.2f)",toString(col), toupper(method), cutoff), outer=TRUE)
}
} else if (is.data.frame(x)) {
if (length(col)>1 & fillout=='null') {
cat('I do not know how to remove univariate outliers in multiple cols. fillout: null --> na ...\n')
fillout='na'
} else if (fillout=='null') {
fillout='todropna'
}
# trick to pass actual col name
x[col] = lapply(1:length(col), function(j) {ez.outlier(x=x[col][[j]],col=col[j],method=method,cutoff=cutoff,plot=plot,hack=hack,fillout=fillout,na.rm=na.rm,print2scr=print2scr)})
if (fillout=='todropna') x=x[complete.cases(x[,col,drop=FALSE]),,drop=FALSE]
} # end if
return(invisible(x))
}
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？