web-dev-qa-db-ja.com

ゼロ分散変数を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)
}

そして、これがプロセスの結果です：

> 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
rdata-management
26
Zach

table()は使用しないでください。このような場合には非常に時間がかかります。 1つのオプションは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)))

これは、同様の出力を提供しながら、サンプルのデータセットであなたよりも1桁高速です。

> 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

しかし、それらが実際の問題のサイズと同様にスケーリングするかどうかを確認する必要があります。

18
Gavin Simpson

また、キャレットパッケージのnearZeroVar()関数を調べることもできます。

1000のうち1つのイベントがある場合、これらのデータを破棄することをお勧めします（ただし、これはモデルによって異なります）。 nearZeroVar()はそれを行うことができます。

23
topepo

単にtableを使用しないでください。数値ベクトルは文字列に変換されるため、数値ベクトルでは非常に遅くなります。私はおそらく次のようなものを使うでしょう

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

分散が0の場合はTRUE、NAのある列の場合はNA、非ゼロの分散の場合はFALSEになります。

11
Simon Urbanek

Caretパッケージと関数nearZeroVarを使用します

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

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
2
James

まあ、あなた自身のコーディング時間を節約してください：

_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)]がうまくいきます。

2
Carl Witthoft

このカスタム関数を確認してください。 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)])
}
0
Muhammad Elkharashy

分散がゼロであることは定数であることと同等であり、算術演算をまったく行わずに回避できます。 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])
}
0
Rolf L