rowMean如果行通過測試

Question

我正在處理一個數據集，其中源名稱由變量前面的2個字母縮寫指定。所以來自源AA的所有變量都以AA_var1開頭，而源bb有bb_variable_name_2。實際上有很多來源和大量的變量名，但是我只留下了2個作爲最小的例子。

我想創建一個平均值的變量，其中源的數量，也就是說，該行上的數據不是NA的唯一前綴的數量大於1的任何行。如果只有一個源，我想這個總變量是NA。

因此，舉例來說，我的數據是這樣的：

> head(df) 
    AA_var1 AA_var2 myid bb_meow bb_A_v1 
1  NA  NA 123456  10  12 
2  NA  10 194200  12  NA 
3  12  10 132200  NA  NA 
4  12  NA 132201  NA  12 
5  NA  NA 132202  NA  NA 
6  12  13 132203  14  NA 

而且我想以下幾點：

> head(df) 
    AA_var1 AA_var2 myid bb_meow bb_A_v1 rowMeanIfDiverseData 
1  NA  NA 123456  10  12     NA #has only bb 
2  NA  10 194200  12  NA     11 #has AA and bb 
3  12  10 132200  NA  NA     NA #has only AA 
4  12  NA 132201  NA  12     12 #has AA and bb 
5  NA  NA 132202  NA  NA     NA #has neither 
6  12  13 132203  14  NA     13 #has AA and bb 

通常情況下，我只是用rowMeans()對於這種事情。但是，只選擇變量名遵循約定/行級/的行的額外子集使我感到困惑於項目級和我習慣的通用應用級聲明。

我可以在數據幀級別的前綴：

mynames <- names(df[!names(df) %in% c("myid")]) 
tmp <- str_extract(mynames, perl("[A-Za-z]{2}(?=_)")) 
uniq <- unique(tmp[!is.na(tmp)]) 

所以，

> uniq 
[1] "AA" "bb" 

所以，我可以把這個功能我可以申請的df，像這樣：

multiSource <- function(x){ 
    nm = names(x[!names(x) %in% badnames])   # exclude c("myid") 
    tmp <- str_extract(nm, perl("[A-Za-z]{2}(?=_)")) # get prefixes 
    uniq <- unique(tmp[!is.na(tmp)])     # ensure unique and not NA 
    if (length(uniq) > 1){ 
     return(T) 
    } else { 
     return(F) 
    } 
} 

但是，這是顯而易見的困惑，並仍然獲得數據集級別，即：

> lapply(df,multiSource) 
$AA_var1 
[1] FALSE 

$AA_var2 
[1] FALSE 

$bb_meow 
[1] FALSE 

$bb_A_v1 
[1] FALSE 

而且......

> apply(df,MARGIN=1,FUN=multiSource) 

給出適用於所有。

我，否則要被說...

df$rowMean <- rowMeans(df, na.rm=T) 

# so, in this case 
rowMeansIfTest <- function(X,test) { 
    # is this row muliSource True? 
    # if yes, return(rowMeans(X)) 
    # else return(NA) 
} 

df$rowMeanIfDiverseData <- rowMeansIfTest(df, test=multiSource) 

但我不清楚如何做到這一點沒有某種形式的for循環。

Answer 1

這裏的策略是通過列分割數據幀分成變量組，對於每一行標識是否存在非NA值。然後我們檢查rowsums以確保至少有兩個非NA值的變量用於一行，如果是這樣，請將這些值的平均值與cbind相加。

這將推廣到任意數量的列，只要它們以AA_varXXX格式命名，並且只要非格式的唯一列是myid。如果情況不是這樣的，那麼容易修復，但這些是現在編寫的代碼的限制。

df.dat <- df[!names(df) == "myid"] 
diverse.rows <- rowSums(
    sapply(
    split.default(df.dat, gsub("^([A-Z]{2})_var.*", "\\1", names(df.dat))), 
    function(x) apply(x, 1, function(y) any(!is.na(y))) 
)) > 1 
cbind(df, div.mean=ifelse(diverse.rows, rowMeans(df.dat, na.rm=T), NA)) 

產地：

AA_var1 AA_var2 myid BB_var3 BB_var4 div.mean 
1  NA  NA 123456  10  12  NA 
2  NA  10 194200  12  NA  11 
3  12  10 132200  NA  NA  NA 
4  12  NA 132201  NA  12  12 
5  NA  NA 132202  NA  NA  NA 
6  12  13 132203  14  NA  13 

Answer 2

這個解決方案對我來說似乎有點複雜，所以可能有更好的方法，但它應該適合你。

# Here's your data: 
df <- data.frame(AA_var1 = c(NA,NA,12,12,NA,12), 
       AA_var2 = c(NA,10,10,NA,NA,13), 
       BB_var3 = c(10,12,NA,NA,NA,14), 
       BB_var4 = c(12,NA,NA,12,NA,NA)) 

# calculate rowMeans for each subset of variables 
a <- rowMeans(df[,grepl('AA',names(df))], na.rm=TRUE) 
b <- rowMeans(df[,grepl('BB',names(df))], na.rm=TRUE) 

# count non-missing values for each subset of variables 
a2 <- rowSums(!is.na(df[,grepl('AA',names(df))]), na.rm=TRUE) 
b2 <- rowSums(!is.na(df[,grepl('BB',names(df))]), na.rm=TRUE) 

# calculate means: 
rowSums(cbind(a*a2,b*b2))/
    rowSums(!is.na(df[,grepl('[AA]|[BB]',names(df))]), na.rm=TRUE) 

結果：

> df$rowMeanIfDiverseData <- rowSums(cbind(a*a2,b*b2))/
+   rowSums(!is.na(df[,grepl('[AA]|[BB]',names(df))]), na.rm=TRUE) 
> df 
    AA_var1 AA_var2 BB_var3 BB_var4 rowMeanIfDiverseData 
1  NA  NA  10  12     NaN 
2  NA  10  12  NA     11 
3  12  10  NA  NA     NaN 
4  12  NA  NA  12     12 
5  NA  NA  NA  NA     NaN 
6  12  13  14  NA     13 

而且一點點清理你的預期輸出完全一致：

> df$rowMeanIfDiverseData[is.nan(df$rowMeanIfDiverseData)] <- NA 
> df 
    AA_var1 AA_var2 BB_var3 BB_var4 rowMeanIfDiverseData 
1  NA  NA  10  12     NA 
2  NA  10  12  NA     11 
3  12  10  NA  NA     NA 
4  12  NA  NA  12     12 
5  NA  NA  NA  NA     NA 
6  12  13  14  NA     13 

Answer 3

我的嘗試，有些冗長.....

dat<-data.frame(AA_var1=c(NA,NA,12,12,NA,12), 
        AA_var2=c(NA,10,10,NA,NA,13), 
        myid=1:6, 
        BB_var3=c(10,12,NA,NA,NA,14), 
        BB_var4=c(12,NA,NA,12,NA,NA)) 

#what columns are associated with variables used in our mean 
varcols<-grep("*var[1-9]",names(dat),value=T) 

#which rows have the requisite diversification of non-nulls 
#i assume these columns will start with capitals and folloowed by underscore 
meanrow<-apply(!is.na(dat[,varcols]),1,function(x){n<-varcols[x] 
           1<length(unique(regmatches(n,regexpr("[A-Z]+_",n)))) 
              }) 
#do the row mean for all 
dat$meanval<-rowMeans(dat[,varcols],na.rm=T) 

#null out for those without diversification (i.e. !meanrow) 
dat[!meanrow,"meanval"]<-NA 

Answer 4

fun <- function(x) { 
    MEAN <- mean(c(x[1], x[2], x[4], x[5]), na.rm=TRUE) 
    CHECK <- sum(!is.na(c(x[1], x[2]))) > 0 & sum(!is.na(c(x[4], x[5])) > 0) 
    MEAN * ifelse(CHECK, 1, NaN) 
} 
df$rowMeanIfDiverseData <- apply(df, 1, fun) 
df 

    AA_var1 AA_var2 myid BB_var3 BB_var4 rowMeanIfDiverseData 
1  NA  NA 123456  10  12     NaN 
2  NA  10 194200  12  NA     11 
3  12  10 132200  NA  NA     NaN 
4  12  NA 132201  NA  12     12 
5  NA  NA 132202  NA  NA     NaN 
6  12  13 132203  14  NA     13 

Answer 5

我想一些問題的答案正在這似乎比它更復雜是。這將做到這一點：

df$means = ifelse(rowSums(!is.na(df[, grep('AA_var', names(df))])) & 
        rowSums(!is.na(df[, grep('BB_var', names(df))])), 
        rowMeans(df[, grep('_var', names(df))], na.rm = T), NA) 
# AA_var1 AA_var2 myid BB_var3 BB_var4 means 
#1  NA  NA 123456  10  12 NA 
#2  NA  10 194200  12  NA 11 
#3  12  10 132200  NA  NA NA 
#4  12  NA 132201  NA  12 12 
#5  NA  NA 132202  NA  NA NA 
#6  12  13 132203  14  NA 13 

這裏給出的評論上述的概括，假設唯一的ID（如果他們沒有，創建而不是唯一的指標）：

library(data.table) 
library(reshape2) 

dt = data.table(df) 
setkey(dt, myid) # not strictly necessary, but makes life easier 

# find the conditional 
cond = melt(dt, id.var = 'myid')[, 
     sum(!is.na(value)), by = list(myid, sub('_var.*', '', variable))][, 
     all(V1 != 0), keyby = myid]$V1 

# fill in the means (could also do a join, but will rely on ordering instead) 
dt[cond, means := rowMeans(.SD, na.rm = T), .SDcols = grep('_var', names(dt))] 

dt 
# AA_var1 AA_var2 myid BB_var3 BB_var4 means 
#1:  NA  NA 123456  10  12 NA 
#2:  12  10 132200  NA  NA NA 
#3:  12  NA 132201  NA  12 12 
#4:  NA  NA 132202  NA  NA NA 
#5:  12  13 132203  14  NA 13 
#6:  NA  10 194200  12  NA 11