Как пластинчатые столбцы в кадре данных и поместить результаты в одном кадре данных

Question

У меня есть кадр данных 400 строк и 1200 столбцов, а общая структура такова:

> df=data.frame(Col1=paste0('row',1:15),metric1=sample(c('H','M','L'),15,replace = 1),metric2=sample(c('H','M'),15,replace = 1)) 
> df 
    Col1 metric1 metric2 ... 
1 row1  M  H 
2 row2  H  L 

Что бы как это сделать, - сравнить табличный результат каждой строки на основе подсчетов HML для каждого столбца.

Я попытался

> apply(df[,2:3],2,function(x) table(x)) 
$metric1 
x 
H L M 
1 7 7 

$metric2 
x 
H M 
10 5 

> 

Но результат список 1200, потому что не все колонки содержат все 3 значения, то есть один столбец имеет только HL, в то время как другой будет иметь HML.

Я также попытался агрегат, который приводит к ошибке

> apply(df[,2:3],2,function(x) aggregate(df$count,list(df[,x]),sum)) 
Error in `[.data.frame`(df, , x) : undefined columns selected 

но моя функция работает:

> aggregate(df$count,list(df[,2]),sum) 
    Group.1 x 
1  H 1 
2  L 7 
3  M 7 
> 

Я надеялся сохранить его в виде кадра данных, таких как:

> data.frame(var=c('H','M','L'),metric1=c(100,100,200),metric2=c(250,150,0)) 
    var metric1 metric2 
1 H  100  250 
2 M  100  150 
3 L  200  0 
> 

Answer 1

Или если вы не хотите использовать цикл, вы также можете назначить уровни в функции таблицы:

apply(df[,2:3],2,function(x) table(factor(x,levels=c("H","M","L")))) 

    metric1 metric2 
H  6  11 
M  8  4 
L  1  0 

Answer 2

Я бы гарантировал, что все table приведут к 3 категориям, первыми преобразуя метрики в факторы ha ving H, L, M как уровни.

Это приводит к:

df=data.frame(Col1=paste0('row',1:15),metric1=sample(c('H','M','L'),15,replace = 1),metric2=sample(c('H','M'),15,replace = 1)) 
for (i in 2:ncol(df)){ 
    df[[i]] <- factor(df[[i]],levels=c("H","M","L")) 
} 

Затем по вызову применить таблицу на каждой колонны и стек:

sapply(df[-1],table) 
     metric1 metric2 
H  3  8 
M  1  7 
L  11  0 

Answer 3

В качестве альтернативы, вы можете сделать что-то вроде:

sumer <- function(data, pattern) 
{ 
     temp <- colSums(sapply(pattern, grepl, data)) 
     names(temp) <- pattern 
     temp 
} 


apply(df[, 2:3], 2, sumer, unique(df[, 2]))