我正在尝试使用一个函数来获取每组数据框3个最常见的数字，但忽略了次要的值(每个组)，并允许一个唯一的数字(如果存在)。接受的答案的system.time最低
#my current function
library(plyr)
get.3modes.andcounts<- function(origtable,groupby,columnname) {
data <- ddply (origtable, groupby, .fun = function(xx){
c(m1 = paste(names(sort(table(xx[,columnname]),decreasing=TRUE)[1])),
m2 = paste(names(sort(table(xx[,columnname]),decreasing=TRUE)[2])),
m3 = paste(names(sort(table(xx[,columnname]),decreasing=TRUE)[3])),
counts=length2(xx[[columnname]], na.rm=TRUE) #http://www.cookbook-r.com/Manipulating_data/Summarizing_data/
) } )
return(data)
}
length2 <- function (x, na.rm=FALSE) {
if (na.rm) sum(!is.na(x))
else length(x)
}
# example df
col2<-c(4, 4, 4, 4, 5, 3, 3, 3, 2, 2, # group1 "5" is the less common
2, 2, 2, 4, 4, 3, 3, 2, 2, 2, # group2 "3" and "4" are equally less common, and there is 2 more frequent
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, # group3 "4" is unique
4, 4, 4, 4, 5, 5, 5, 5, 2, 2, # group4 "2" is the less common, other ties more frequent
4, 4, 4, 4, 4, 5, 5, 5, 5, 5) # group5 "4" and "5" are equally common and no value is less common (similar to unique)
col1<-paste(c(rep("group1",10),rep("group2",10),rep("group3",10),rep("group4",10),rep("group5",10)), sep=", ")
df<-data.frame(col1=col1,col2=col2)
get.3modes.andcounts(df,"col1","col2")
#CURRENT result
col1 m1 m2 m3 counts
1 group1 4 3 2 10 # ok
2 group2 2 3 4 10 # no, 3 and 4 are the less common
3 group3 4 NA NA 10 # ok
4 group4 4 5 2 10 # no, 2 is less common
5 group5 4 5 NA 10 # ok
# desired
col1 m1 m2 m3 counts
1 group1 4 3 2 10
2 group2 2 NA NA 10
3 group3 4 NA NA 10
4 group4 4 5 NA 10
5 group5 4 5 NA 10
编辑:实际样本有几个联系，并且不希望有超过3列。仅在出现平局时才接受3个以上的数字(3列)。因此，我决定要求另一种类型的输出。
编辑:group7。只有三个最常见的通缉犯。异常(exception)，包括第3位最常见的联系(与其他组一样)。
# EXAMPLE 2
# new proposal
col2<-c(4, 4, 4, 4, 5, 3, 3, 3, 2, 2, 6, 6, # group1 2 and 6 tied in the 3rd position, 5 less common
2, 2, 2, 4, 4, 3, 3, 2, 2, 2, 6, 6, # group2 4, 3 and 6 tied in the less common, excluded.
4, 4, 4, 7, 7, 7, 5, 5, 5, 4, 4, 6, # group3 4, 7 and 5 more common, 3 most common present, exclude everything else
4, 4, 4, 4, 5, 5, 5, 5, 2, 2, 6, 6, # group4 2 and 6 less common, excluded (4 AND 5 tied)
4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, # group5 6 less common, excluded, (4 and 5 tied)
4, 4, 4, 3, 3, 3, 2, 2, 2, 1, 1, 1, # group6 all tied
14,14,14,16,16,16,16,34,34,42,42,42,80,80,84,92, #group7 16, 14, 42 are the three most freq.
20,52,40,40,40,20,20,60,60,50) #group 8 20,40 tied, 60 next.
col1<-paste(c(rep("group1",12),rep("group2",12),rep("group3",12),rep("group4",12),rep("group5",12),
rep("group6",12),rep("group7",16),rep("group8", 10)), sep=", ")
df<-data.frame(col1=col1,col2=col2)
#desired output
col1 m1 m2 m3 counts
1 group1 4 3 2,6 12 # 2 and 6 tied in the 3rd position, 5 less common
2 group2 2 NA NA 12 # 4, 3 and 6 tied in the less common, excluded.
3 group3 4 7,5 NA 12 # three most common numbers present, exclude everything else
4 group4 4,5 NA NA 12 # 2 and 6 less common excluded (4 AND 5 tied)
5 group5 4,5 NA NA 12 # 6 less common, excluded, (4 and 5 tied)
6 group6 4,3,2,1 NA NA 12 # all tied
7 group7 16 14,42 NA 16 # three most frequent present, discard others
8 group8 20,40 60 NA 10 # three most frequent present
最佳答案
您可以更改n > 0，它将起作用。您的问题要求3，但是我的答案将是更通用的(接受任何正整数)。
使用基数R:
myfun <- function( data, n = 3, col1, col2 )
{
## n: numeric: total number of most common elements per group
stopifnot( n > 0 )
a1 <- lapply( split( data, data[[col1]] ), function( x ) { # split data by col1
# browser()
val <- factor( x[[col2]] ) # factor of data values
z1 <- tabulate( val ) # frequency table of levels of val
z2 <- sort( z1[ z1 > 0 ], decreasing = TRUE ) # sorted frequency table with >0
lenx <- length( unique( z2 ) ) # length of unique of z2
if ( lenx == 1 ) { # lenx == 1
return( c( paste( ( levels(val)[ which( z1 %in% z2 ) ] ), collapse = ','), rep(NA_character_, n - 1 ), sum( z1 ) ) )
} else if ( lenx > 1 ) { # lenx > 1
# remove the minimum, and and extract values by using levels of val with indices from the match of z1 and z2
z2 <- setdiff( z2, min( z2 ) )
z2 <- sapply( z2, function( y ) paste( levels(val)[ which( z1 %in% y ) ], collapse = ',') )
# count the length of z2 and get indices of length >= n
z2_ind <- which( cumsum( lengths(unlist( lapply(z2, strsplit, split = "," ),
recursive = F ) ) ) >= n )
if( length( z2_ind ) > 0 ) {
z2 <- z2[ seq_len( z2_ind[1] ) ]
}
# adjust length by assigning NA
if( length(z2) != n ) { z2[ (length(z2)+1):n ] <- NA_character_ }
return( c( z2, sum( z1 ) ) )
} else { # lenx < 1
return( as.list( rep(NA_character_, n ), NA_character_ ) )
}})
a1 <- do.call('rbind', a1) # row bind values of a1
a1 <- data.frame( group = rownames( a1 ), a1, stringsAsFactors = FALSE )
colnames( a1 ) <- c( 'group', paste( 'm', 1:n, sep = '' ), 'count' )
rownames( a1 ) <- NULL # remove row names
return( a1 )
}
输出:
# example1:
myfun(df, 3, 'col1', 'col2')
# group m1 m2 m3 count
# 1 group1 4 3 2 10
# 2 group2 2 NA NA 10
# 3 group3 4 NA NA 10
# 4 group4 4, 5 NA NA 10
# 5 group5 4, 5 NA NA 10
# example 2
myfun(df3, 3, 'col1', 'col2')
# group m1 m2 m3 count
# 1 group1 4 3 2, 6 12
# 2 group2 2 NA NA 12
# 3 group3 4 5, 7 NA 12
# 4 group4 4, 5 NA NA 12
# 5 group5 4, 5 NA NA 12
# 6 group6 4, 3, 2, 1 NA NA 12
# 7 group7 16 14, 42 NA 16
通过为
example 1 data df 的第3列分配字母，创建字符数据而不是数字数据。set.seed(1L)
df$col3 <- sample( letters, 50, TRUE )
myfun(df, 3, 'col1', 'col3')
# group m1 m2 m3 count
# 1 group1 x <NA> <NA> 10
# 2 group2 j,u <NA> <NA> 10
# 3 group3 a,d,f,g,i,j,k,q,w,y <NA> <NA> 10
# 4 group4 m <NA> <NA> 10
# 5 group5 u <NA> <NA> 10