在data.frame中有效定位組合常數列

Question

如何從數據框中有效地提取組合常數列？我已經在下面包含了一個plyr實現來明確我想要做什麼，但是它很慢。我怎樣才能儘可能有效地做到這一點？ （理想情況下，根本不分割數據幀）。

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) 

在我的實際使用情況下（在內心深處GGPLOT2）有可能是恆定的，非恆列的任意數量。示例中數據的大小約爲正確的數量級。

Answer 1

通過@ Joran的回答啓發，這裏有類似的策略，這是一個快一點（1 s和1.5秒，我的機器上）

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) 

它具有相同的缺陷，雖然，因爲它不會檢測列那正在對相鄰組

相同的值（例如，df$f <- 1）隨着多一點思考加上@大衛的想法：

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 

這給出正確的結果。

Answer 2

（編輯：更好的答案）

什麼像

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

這似乎是一個不錯的改進。比較以下內容。

> 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

（編輯，以應對可能具有相同值的連續組的問題）

我試探性地提交這個答案，但我還沒有完全相信自己，它會正確識別內在所有情況下都是組常量列。但它肯定更快（大概可以提高）：

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

我的基本想法是使用rle，效果顯着。

Answer 4

我不確定這是否正是您正在尋找的內容，但它確定了列a和b。

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

is.unsorted(x)對非常數x失效有多快？可悲的是，我目前無法訪問R。也似乎不是你的瓶頸，但。

Answer 6

一點比哈德利上面所建議的速度較慢，但​​我認爲它應該處理等於相鄰的基團

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

的直覺是的情況下，如果一個列是恆定的GroupWise然後列中的值的中斷（按組值排序）將是組值中斷的子集。

現在，隨着哈德利的它比較（與小的修改，以確保n定義）

# 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