quick - r variables

Eliminar rápidamente las variables de varianza cero de un data.frame

Question

Tengo un gran data.frame que fue generado por un proceso fuera de mi control, que puede o no contener variables con varianza cero (es decir, todas las observaciones son iguales) Me gustaría construir un modelo predictivo basado en estos datos, y obviamente estas variables no sirven de nada.

Aquí está la función que estoy usando actualmente para eliminar tales variables del data.frame. Actualmente se basa en apply , y me preguntaba si hay formas obvias de acelerar esta función, de modo que funcione rápidamente en conjuntos de datos muy grandes, con un gran número (400 o 500) de variables.

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

Y aquí está el resultado del proceso:

> 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

Answer 1

¿Qué hay de usar factor para contar el número de elementos únicos y hacer un bucle con 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

Las NA se excluyen de forma predeterminada, pero esto se puede cambiar con el parámetro exclude del 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

Answer 2

Bueno, ahórrate un tiempo de codificación:

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.   

Para evitar redondeos desagradables de punto flotante, tome ese vector de salida, que llamaré "barra", y haga algo como bar[bar< 2*.Machine$double.eps] <- 0 y luego, finalmente, sus datos de marco de datos dat[,as.logical(bar)] debería hacer el truco.

Answer 3

Compruebe esta función personalizada. No lo probé en marcos de datos con más de 100 variables.

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

Answer 4

Creo que tener una varianza cero es equivalente a ser constante y uno puede moverse sin hacer ninguna operación aritmética. Espero que el rango () supere a var (), pero no he verificado esto:

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

Answer 5

No use table() - muy lento para tales cosas. Una opción es la 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)))

Que es una magnitud de orden más rápida que la suya en el conjunto de datos de ejemplo al tiempo que ofrece resultados similares:

> 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

La solución de Simon aquí es igualmente rápida en este ejemplo:

> 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

pero tendrá que ver si se escalan de manera similar a los problemas reales.

Answer 6

Simplemente no use la table , es extremadamente lento en vectores numéricos ya que los convierte en cadenas. Probablemente usaría algo como

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

Será TRUE para varianza de 0, NA para columnas con NA y FALSE para varianza no cero

Answer 7

También es posible que desee ver la función nearZeroVar() en el paquete caret.

Si tiene un evento de 1000, puede ser una buena idea descartar estos datos (pero esto depende del modelo). nearZeroVar() puede hacer eso.

Answer 8

Utilice el paquete Caret y la función nearZeroVar

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