快速从data.frame中删除零方差变量

我有一个由我无法控制的过程生成的大型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)
}

---

简单地说，不要使用

表

——它在数字向量上的速度非常慢，因为它会将它们转换为字符串。我可能会使用类似

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

---

var0好吧，为自己节省一些编码时间：

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.   

Rgames:foo
[,1]  [,2] [,3]
[1，]1 1e+00 1
[2，]1 2e+00 1
[3，]1 3e+00 1
[4，]14E+001
[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
警告信息：
sd（）已弃用。
改为使用apply（*，2，sd）。

为了避免令人讨厌的浮点舍入，使用输出向量，我将其称为“bar”，并执行类似于
bar[bar<2*.Machine$double.eps]的操作。您可能还需要查看插入符号包中的
nearZeroVar（）
函数

如果1000个事件中有一个事件，丢弃这些数据可能是个好主意（但这取决于模型）
nearZeroVar（）
可以做到这一点。
不要使用
table（）
-这类操作非常慢。一个选项是
长度（唯一（x））
：

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

但你必须看看它们的规模是否与实际问题的规模相似
 使用
因子
来计算唯一元素的数量，并使用
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被排除在外，但这可以通过
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

我认为零方差等于常数，一个人不用做任何算术运算就可以四处走动。我希望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])
}

removeConstantColumns使用
Caret
包和函数
nearZeroVar

require(caret)
NZV<- nearZeroVar(dataset, saveMetrics = TRUE)
NZV[NZV[,"zeroVar"] > 0, ] 
NZV[NZV[,"zeroVar"] + NZV[,"nzv"] > 0, ]

require（插入符号）
NZV 0，]
NZV[NZV[，“zeroVar”]+NZV[，“NZV”]>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)])
}

删除\u低\u差异\u列%
聚集（）%>%
过滤器（值%
排列（键，值）%>%
姓名（）
if（长度（删除列））{
打印（“删除以下列：”）
打印（删除列）
}否则{
打印（“没有具有此阈值的低方差列”）
}
#这个脚本花了多长时间？
打印（粘贴（“所用时间：”，Sys.Time（）-n，“秒”））
返回（df[，setdiff（名称（df），删除列）]）
}
因为我是一个不断用谷歌搜索同一个问题的白痴，让我留下一个我已经确定的
tidyverse
方法：

library(tidyverse)

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

库（tidyverse）
df%
挑选(
- {
df%>%
地图直径（~length（表格（.x，useNA=“ifany”））%>%
{其中（.==1）}%>%
姓名（）
}
)

我想这可以缩短，但我太累了！
Carl-用发布的数据框试试-由于各种因素，你会得到
NA
s；）@Simon-是的，我知道。。。我跳过了清理和/或验证源数据的步骤。我为懒惰辩护。谢谢你的建议，我实际上一直在使用
nearZeroVar（）
，这个问题就是基于这个函数的。我偶尔会发现自己只想删除零方差变量，并以另一种方式处理“近零方差”变量（例如，稍后将几个近零方差变量组合成一个新变量）。我只是在使用
nearZeroVar（）
时尝试了这种方法，设置
saveMetrics=T
，然后输出将同时为您提供
zeroVar
（0方差）和
nzv
（接近0方差），通过在函数中设置其他阈值，您可以确定接近0方差的不同值百分比的截止值。因此，我认为这种方法更简单、更灵活。对于包含所有
NA
s的列，要将其设置为
TRUE
，对于包含
NA
s和其他值的列，要将其设置为
FALSE
有多难？很好。在这里或者更一般地说，是否有任何理由更喜欢
unlist（lappy（…）
而不是
sapply（…）
？嗯，
sapply
调用
lappy
，然后对结果进行更多的处理，最后调用
unlist
，所以我喜欢使用更原始的函数，这样我就知道它们做什么了-这只是我个人的偏好（有时更有效）。简单-只需通过
na.rm
传递到
var
，就像使用
table
一样：
var0，正如我在（较弱的）解决方案中指出的，小心
长度（唯一的）（x） ）
除非您确定x都是整数。一个有效的解决方案实际上似乎是
，它（！unlist（lappy（dat，+函数（x）0==var（if（is.factor（x））as.integer（x）else x）））
，因为当前解决方案正好引用了0个方差列。
require(caret)
NZV<- nearZeroVar(dataset, saveMetrics = TRUE)
NZV[NZV[,"zeroVar"] > 0, ] 
NZV[NZV[,"zeroVar"] + NZV[,"nzv"] > 0, ]

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)])
}

library(tidyverse)

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