29

我有一个很大的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
4

9 回答 9

28

您可能还想查看nearZeroVar()caret 包中的函数。

如果您有 1000 个事件中的一个，则丢弃这些数据可能是个好主意（但这取决于模型）。nearZeroVar()可以做到这一点。

于 2012-01-10T15:38:59.103 回答
21

不要使用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

西蒙在这里的解决方案在这个例子中同样快速：

> 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

但是您必须查看它们是否与实际问题的大小相似。

于 2012-01-10T16:03:06.750 回答
11

根本不要使用table- 它在数字向量上非常慢，因为它将它们转换为字符串。我可能会使用类似的东西

var0 <- unlist(lapply(df, function(x) 0 == var(if (is.factor(x)) as.integer(x) else x)))

它将TRUE用于 0 方差、NA具有 NA 的列和FALSE非零方差

于 2012-01-10T15:34:43.597 回答
5

使用Caret包和功能nearZeroVar

require(caret)
NZV<- nearZeroVar(dataset, saveMetrics = TRUE)
NZV[NZV[,"zeroVar"] > 0, ] 
NZV[NZV[,"zeroVar"] + NZV[,"nzv"] > 0, ]
于 2018-01-02T15:18:54.640 回答
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

默认情况下不包括 NA，但这可以通过以下exclude参数进行更改factor：

dat[sapply(dat, function(x) length(levels(factor(x,exclude=NULL)))>1)]
   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
于 2012-01-10T16:15:39.723 回答
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.

为避免令人讨厌的浮点舍入，请使用该输出向量，我将其称为“bar”，然后执行类似的操作bar[bar< 2*.Machine$double.eps] <- 0，最后您的数据框dat[,as.logical(bar)]应该可以解决问题。

于 2012-01-10T15:35:02.623 回答
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])
}
于 2017-11-02T16:53:09.857 回答
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)])
}
于 2018-09-23T12:04:13.950 回答
0

因为我是一个一直在谷歌上搜索相同问题的白痴，所以让我留下一个tidyverse我已经确定的方法：

library(tidyverse)

df <- df %>%
  select(
    - {
      df %>%
        map_dbl(~ length(table(.x, useNA = "ifany"))) %>%
        {which(. == 1)} %>%
        names()
    }
  )

我认为这可以缩短，但我太累了！

于 2021-05-13T03:05:07.730 回答