R - режим расчета и проценты по режиму и цели

Question

Я пытаюсь рассчитать режим для числовых столбцов. Столбцы, которые не являются числовыми, должны иметь "NA" в качестве заполнителя в векторе. Мне также нужны проценты в зависимости от цели. Некоторые примеры данных:

c1= c("A", "B", "C", "C", "B", "C", "C") 
c2= factor(c(1, 1, 2, 2,1,2,1), labels = c("Y","N"))
d= as.Date(c("2015-02-01", "2015-02-03","2015-02-01","2015-02-05", "2015-02-03","2015-02-01", "2015-02-03"), format="%Y-%m-%d")
x= c(1,1,2,3,1,2,4) 
y= c(1,2,2,6,2,3,1) 
t= c(1,0,1,1,0,0,1)
df=data.frame(c1, c2, d, x, y,t) 
df

  c1 c2          d x y t
1  A  Y 2015-02-01 1 1 1
2  B  Y 2015-02-03 1 2 0
3  C  N 2015-02-01 2 2 1
4  C  N 2015-02-05 3 6 1
5  B  Y 2015-02-03 1 2 0
6  C  N 2015-02-01 2 3 0
7  C  Y 2015-02-03 4 1 1

Мне нужен режим для каждого числового столбца:

mode=as.numeric(c("NA","NA", "NA", 1,2,1))
mode
[1] NA NA NA  1  2  1

и вектор процентов строк с t==1, когда значение в режиме column ==

[1] NA NA NA  0.33  0.33  

и вектор процентов строк с t==1, когда значение в столбце!= mode

[1] NA NA NA  0.75  0.75

Как я мог рассчитать такие векторы?

Лучшее, что я нашел для режима:

library(plyr)

mode_fun <- function(x) {
  mode0 <- names(which.max(table(x)))
  if(is.numeric(x)) return(as.numeric(mode0))
  mode0
}
kdf_mode=apply(kdf,2, numcolwise(mode_fun))

Но это дает ошибку, если есть какие-либо нечисловые столбцы.

Answer 1

Мы можем использовать sapply чтобы перебрать столбцы 'df', примените mode_fun чтобы получить выход vector ('V1'). Мы используем if/else условие для возвращения NA для нечисловых столбцов.

 v1 <- unname(sapply(df, function(x) if(!is.numeric(x)) NA else mode_fun(x)))
 v1
 #[1] NA NA NA  1  2  1

Для второго случая (я думаю, нам не нужен шестой столбец, т. Е. 'T'). Мы перебираем столбцы df с помощью sapply, использовать if/else состояние. в else условие, мы сравним ли mode значения равны значениям столбца (mode_fun(x)==x)). Мы используем & чтобы получить логический индекс значений, которые равны mode что соответствует t==1, Получить sum и разделить на sum(v1),

unname(sapply(df[-6], function(x) if(!is.numeric(x)) {
            NA
            } else {
                v1 <- mode_fun(x)==x
                sum(v1 & t==1)/sum(v1) 
  } ))
 #[1]        NA        NA        NA 0.3333333 0.3333333

Для третьего мы изменим условие, чтобы получить логический индекс, где столбец не равен mode, Сделайте так же, как в предыдущем случае.

unname(sapply(df[-6], function(x) if(!is.numeric(x)){
         NA 
         } else {
              v1 <- mode_fun(x)!=x
              sum(v1 & t==1)/sum(v1)
   } ))
 #[1]   NA   NA   NA 0.75 0.75

---

После того, как мы вычислим 'v1', это также можно сделать без зацикливания sapply, Мы создаем логический индекс, где столбец class является "числовым", а имена столбцов не "t" ("indx").

indx <- sapply(df, is.numeric) &  names(df)!='t'

Подмножество 'df' и 'v1' основано на 'indx' (df[indx], v1[indx]), сделайте длины, копируя vector с помощью col, col дает числовой индекс столбцов в df[indx], Затем мы проверяем, равен ли набор данных подмножества vector дать логическую матрицу.

indx1 <- df[indx]==v1[indx][col(df[indx])] 

Как и в предыдущем коде, мы используем & проверить, является ли TRUE значения в 'indx1' также соответствуют 't == 1. DocolSums, divide by thecolSumsof 'indx1', and concatenate (с) with theNA` элементы 'v1'

unname(c(v1[is.na(v1)], colSums(indx1& t==1)/colSums(indx1)))
#[1]        NA        NA        NA 0.3333333 0.3333333

Точно так же мы можем создать 'indx2', изменив условие, а затем сделать colSums как прежде

indx2 <- df[indx]!=v1[indx][col(df[indx])] 
unname(c(v1[is.na(v1)], colSums(indx2& t==1)/colSums(indx2)))
#[1]   NA   NA   NA 0.75 0.75