我有一个由我的控制之外的进程生成的大型data.frame，它可能包含也可能不包含零方差的变量（即所有观察结果都相同）。我想基于这些数据建立一个预测模型，显然这些变量是没有用的。
这是我目前用来从data.frame中删除这些变量的函数。它目前基于apply，我想知道是否有任何明显的方法来加速这个功能，以便它可以在非常大的数据集上快速工作，具有大量（400或500）变量？
set.seed(1)
dat <- data.frame(
A=factor(rep("X",10),levels=c('X','Y')),
B=round(runif(10)*10),
C=rep(10,10),
D=c(rep(10,9),1),
E=factor(rep("A",10)),
F=factor(rep(c("I","J"),5)),
G=c(rep(10,9),NA)
)
zeroVar <- function(data, useNA = 'ifany') {
out <- apply(data, 2, function(x) {length(table(x, useNA = useNA))})
which(out==1)
}
这是这个过程的结果：
> dat
A B C D E F G
1 X 3 10 10 A I 10
2 X 4 10 10 A J 10
3 X 6 10 10 A I 10
4 X 9 10 10 A J 10
5 X 2 10 10 A I 10
6 X 9 10 10 A J 10
7 X 9 10 10 A I 10
8 X 7 10 10 A J 10
9 X 6 10 10 A I 10
10 X 1 10 1 A J NA
> dat[,-zeroVar(dat)]
B D F G
1 3 10 I 10
2 4 10 J 10
3 6 10 I 10
4 9 10 J 10
5 2 10 I 10
6 9 10 J 10
7 9 10 I 10
8 7 10 J 10
9 6 10 I 10
10 1 1 J NA
> dat[,-zeroVar(dat, useNA = 'no')]
B D F
1 3 10 I
2 4 10 J
3 6 10 I
4 9 10 J
5 2 10 I
6 9 10 J
7 9 10 I
8 7 10 J
9 6 10 I
10 1 1 J
答案 0 :(得分：23)
您可能还想查看插入符号包中的nearZeroVar()函数。
如果你有1000个中的一个事件，丢弃这些数据可能是个好主意（但这取决于模型）。 nearZeroVar()可以做到这一点。
答案 1 :(得分：18)
不要使用table() - 这类事情非常慢。一个选项是length(unique(x))：
foo <- function(dat) {
out <- lapply(dat, function(x) length(unique(x)))
want <- which(!out > 1)
unlist(want)
}
system.time(replicate(1000, zeroVar(dat)))
system.time(replicate(1000, foo(dat)))
在给出类似输出的同时，在示例数据集上，这比您的数量级快一些：
> system.time(replicate(1000, zeroVar(dat)))
user system elapsed
3.334 0.000 3.335
> system.time(replicate(1000, foo(dat)))
user system elapsed
0.324 0.000 0.324
Simon的解决方案在这个例子中同样很快：
> system.time(replicate(1000, which(!unlist(lapply(dat,
+ function(x) 0 == var(if (is.factor(x)) as.integer(x) else x))))))
user system elapsed
0.392 0.000 0.395
但你必须看看它们是否与真正的问题规模相似。
答案 2 :(得分：11)
简单地不使用table - 它在数字向量上非常慢，因为它将它们转换为字符串。我可能会使用像
var0 <- unlist(lapply(df, function(x) 0 == var(if (is.factor(x)) as.integer(x) else x)))
对于0-variance，TRUE，对于具有NA的列，NA，对于非零方差，FALSE
答案 3 :(得分：4)
使用C:\Program Files\Java\jdk1.8.0_131包和函数Caret
nearZeroVar答案 4 :(得分：2)
好吧，节省一些编码时间：
Rgames: foo
[,1] [,2] [,3]
[1,] 1 1e+00 1
[2,] 1 2e+00 1
[3,] 1 3e+00 1
[4,] 1 4e+00 1
[5,] 1 5e+00 1
[6,] 1 6e+00 2
[7,] 1 7e+00 3
[8,] 1 8e+00 1
[9,] 1 9e+00 1
[10,] 1 1e+01 1
Rgames: sd(foo)
[1] 0.000000e+00 3.027650e+00 6.749486e-01
Warning message:
sd(<matrix>) is deprecated.
Use apply(*, 2, sd) instead.
为了避免令人讨厌的浮点舍入，请使用我输出的输出向量＆＃34; bar，＆＃34;并执行bar[bar< 2*.Machine$double.eps] <- 0之类的操作，最后您的数据框dat[,as.logical(bar)]应该可以解决问题。
答案 5 :(得分：2)
如何使用factor计算唯一元素的数量并使用sapply进行循环：
dat[sapply(dat, function(x) length(levels(factor(x)))>1)]
B D F
1 3 10 I
2 4 10 J
3 6 10 I
4 9 10 J
5 2 10 I
6 9 10 J
7 9 10 I
8 7 10 J
9 6 10 I
10 1 1 J
默认情况下会排除NAs，但可以使用exclude的{{1}}参数进行更改：
factor答案 6 :(得分：0)
我认为零方差相当于保持不变，并且可以在不进行任何算术运算的情况下绕过。我希望range（）的性能优于var（），但我还没有验证：
removeConstantColumns <- function(a_dataframe, verbose=FALSE) {
notConstant <- function(x) {
if (is.factor(x)) x <- as.integer(x)
return (0 != diff(range(x, na.rm=TRUE)))
}
bkeep <- sapply(a_dataframe, notConstant)
if (verbose) {
cat('removeConstantColumns: '
, ifelse(all(bkeep)
, 'nothing'
, paste(names(a_dataframe)[!bkeep], collapse=',')
, ' removed', '\n')
}
return (a_dataframe[, bkeep])
}
答案 7 :(得分：0)
选中此自定义功能。我没有在具有100多个变量的数据帧上尝试过。
remove_low_variance_cols <- function(df, threshold = 0) {
n <- Sys.time() #See how long this takes to run
remove_cols <- df %>%
select_if(is.numeric) %>%
map_dfr(var) %>%
gather() %>%
filter(value <= threshold) %>%
spread(key, value) %>%
names()
if(length(remove_cols)) {
print("Removing the following columns: ")
print(remove_cols)
}else {
print("There are no low variance columns with this threshold")
}
#How long did this script take?
print(paste("Time Consumed: ", Sys.time() - n, "Secs."))
return(df[, setdiff(names(df), remove_cols)])
}
答案 8 :(得分：0)
因为我是个白痴，总是在谷歌上搜索同样的问题，让我留下我已经确定的 tidyverse 方法：
library(tidyverse)
df <- df %>%
select(
- {
df %>%
map_dbl(~ length(table(.x, useNA = "ifany"))) %>%
{which(. == 1)} %>%
names()
}
)
我认为这可以缩短，但我太累了！