Individuare in modo efficiente le colonne della costante di gruppo in un data.frame

Question

Come posso estrarre in modo efficiente colonne costanti per gruppo da un frame di dati? Di seguito ho incluso un'implementazione plyr per rendere preciso ciò che sto cercando di fare, ma è lento. Come posso farlo nel modo più efficiente possibile? (Idealmente senza dividere il frame di dati).

base <- data.frame(group = 1:1000, a = sample(1000), b = sample(1000)) 
df <- data.frame(
    base[rep(seq_len(nrow(base)), length = 1e6), ], 
    c = runif(1e6), 
    d = runif(1e6) 
) 


is.constant <- function(x) length(unique(x)) == 1 
constant_cols <- function(x) head(Filter(is.constant, x), 1) 
system.time(constant <- ddply(df, "group", constant_cols)) 
# user system elapsed 
# 20.531 1.670 22.378 
stopifnot(identical(names(constant), c("group", "a", "b"))) 
stopifnot(nrow(constant) == 1000) 

Nel mio caso reale utilizzo (profondità ggplot2) vi può essere un numero arbitrario di colonne costanti e non costanti. La dimensione dei dati nell'esempio riguarda il giusto ordine di grandezza.

Answer 1

Ispirato @ risposta di Joran, ecco strategia simile che è un po 'più veloce (1 s vs 1,5 s sulla mia macchina)

changed <- function(x) c(TRUE, x[-1] != x[-n]) 

constant_cols2 <- function(df,grp){ 
    df <- df[order(df[,grp]),] 
    n <- nrow(df) 
    changes <- lapply(df, changed) 

    vapply(changes[-1], identical, changes[[1]], FUN.VALUE = logical(1)) 
} 
system.time(cols <- constant_cols2(df, "group")) # about 1 s 

system.time(constant <- df[changed(df$group), cols]) 
# user system elapsed 
# 1.057 0.230 1.314 

stopifnot(identical(names(constant), c("group", "a", "b"))) 
stopifnot(nrow(constant) == 1000) 

Ha gli stessi difetti, però, in quanto non in grado di rilevare le colonne sono avere gli stessi valori per i gruppi adiacenti (per esempio df$f <- 1)

Con un altro pensiero bit più @ idee di David:

constant_cols3 <- function(df, grp) { 
    # If col == TRUE and group == FALSE, not constant 
    matching_breaks <- function(group, col) { 
    !any(col & !group) 
    } 

    n <- nrow(df) 
    changed <- function(x) c(TRUE, x[-1] != x[-n]) 

    df <- df[order(df[,grp]),] 
    changes <- lapply(df, changed) 
    vapply(changes[-1], matching_breaks, group = changes[[1]], 
    FUN.VALUE = logical(1)) 
} 

system.time(x <- constant_cols3(df, "group")) 
# user system elapsed 
# 1.086 0.221 1.413 

e che dà il risultato corretto .

Answer 2

(edit: risposta migliore)

Che dire qualcosa di simile

is.constant<-function(x) length(which(x==x[1])) == length(x)

Questo sembra essere un bel miglioramento. Confronta il seguente

> a<-rnorm(5000000) 

> system.time(is.constant(a)) 
    user system elapsed 
    0.039 0.010 0.048 
> 
> system.time(is.constantOld(a)) 
    user system elapsed 
    1.049 0.084 1.125 

Answer 3

(A cura di affrontare eventualmente la questione dei gruppi consecutivi con lo stesso valore)

sto timidamente presentazione di questa risposta, ma non ho del tutto me stesso convinto che possa identificare correttamente all'interno raggruppa colonne costanti in tutti i casi. Ma è sicuramente più veloce (e probabilmente può essere migliorata):

constant_cols1 <- function(df,grp){ 
    df <- df[order(df[,grp]),] 

    #Adjust values based on max diff in data 
    rle_group <- rle(df[,grp]) 
    vec <- rep(rep(c(0,ceiling(diff(range(df)))), 
       length.out = length(rle_group$lengths)), 
       times = rle_group$lengths) 
    m <- matrix(vec,nrow = length(vec),ncol = ncol(df)-1) 
    df_new <- df 
    df_new[,-1] <- df[,-1] + m 

    rles <- lapply(df_new,FUN = rle) 
    nms <- names(rles) 
    tmp <- sapply(rles[nms != grp], 
        FUN = function(x){identical(x$lengths,rles[[grp]]$lengths)}) 
    return(tmp) 
} 

La mia idea di base era quella di utilizzare rle, ovviamente.

Answer 4

Non sono sicuro se questo è esattamente quello che stai cercando, ma identifica le colonne aeb.

require(data.table) 
is.constant <- function(x) identical(var(x), 0) 
dtOne <- data.table(df) 
system.time({dtTwo <- dtOne[, lapply(.SD, is.constant), by=group] 
result <- apply(X=dtTwo[, list(a, b, c, d)], 2, all) 
result <- result[result == TRUE] }) 
stopifnot(identical(names(result), c("a", "b"))) 
result 

Answer 5

Quanto velocemente si fa is.unsorted(x) fallire per non costante x? Purtroppo non ho accesso a R al momento. Sembra anche che non sia il collo di bottiglia però.

Answer 6

leggermente più lento di quello hadley suggerita, ma penso che dovrebbe gestire il caso di gruppi adiacenti uguali

findBreaks <- function(x) cumsum(rle(x)$lengths) 

constantGroups <- function(d, groupColIndex=1) { 
    d <- d[order(d[, groupColIndex]), ] 
    breaks <- lapply(d, findBreaks) 
    groupBreaks <- breaks[[groupColIndex]] 
    numBreaks <- length(groupBreaks) 
    isSubset <- function(x) length(x) <= numBreaks && length(setdiff(x, groupBreaks)) == 0 
    unlist(lapply(breaks[-groupColIndex], isSubset)) 
} 

L'intuizione è che se una colonna è costante groupwise allora le discontinuità tra i valori delle colonne (ordinato in base al valore del gruppo) sarà un sottoinsieme delle interruzioni nel valore di gruppo.

Ora, si confronti con Hadley di (con piccole modifiche per garantire n è definito)

# df defined as in the question 

n <- nrow(df) 
changed <- function(x) c(TRUE, x[-1] != x[-n]) 

constant_cols2 <- function(df,grp){ 
    df <- df[order(df[,grp]),] 
    changes <- lapply(df, changed) 
    vapply(changes[-1], identical, changes[[1]], FUN.VALUE = logical(1)) 
} 

> system.time(constant_cols2(df, 1)) 
    user system elapsed 
    1.779 0.075 1.869 
> system.time(constantGroups(df)) 
    user system elapsed 
    2.503 0.126 2.614 
> df$f <- 1 
> constant_cols2(df, 1) 
    a  b  c  d  f 
TRUE TRUE FALSE FALSE FALSE 
> constantGroups(df) 
    a  b  c  d  f 
TRUE TRUE FALSE FALSE TRUE