Вернуть наиболее частую строку по группе в базе R

Question

У меня есть набор данных, в котором я хотел бы вернуть наиболее частую запись в столбце b для каждой уникальной записи a, где оба столбца являются символьными векторами.В случае, когда две записи в b одинаково часто встречаются для уникальной записи в a, я хотел бы возвратить обе записи b в отдельных столбцах (требуемый вывод приведен ниже).

Этопохоже на вопрос, заданный здесь , однако ответы на этот вопрос все используют tidyverse.Я склонен к тидиверсу, поскольку объекты тивайверса ломают другие вещи в моем проекте.Ищите базовое решение R (и избегайте разговоров о достоинствах tidyverse).

Мои данные выглядят так:

a <- as.character(c(rep(1:3,4)))
b <- c("A","A","A",
       "B","B","B",
       "A","B","A",
       "A","B","B")
df <- data.frame(a,b)

 a b
 1 A
 2 A
 3 A
 1 B
 2 B
 3 B
 1 A
 2 B
 3 A
 1 A
 2 B
 3 B

желаемый результат:

 group match_1 match_2
     1       A    <NA>
     2       B    <NA>
     3       A       B

Answer 1

Мы можем сделать это за base R

tbl <- table(df)
ifelse(tbl[,1] == tbl[,2], toString(colnames(tbl)), colnames(tbl)[max.col(tbl)])

Answer 2

Другая base альтернатива.

Создание таблицы сопряженности и преобразование во фрейм данных: as.data.frame(table(df)).

Используйте ave для выбора строк с максимальными значениями по группе.

Используйте ave, чтобы создать переменную 'time', чтобы "дифференцировать несколько записей из одной группы" (см. ?reshape).

reshape релевантные переменные для всей ширины.

d <- as.data.frame(table(df))
d2 <- d[d$Freq == ave(d$Freq, d$a, FUN = max), ]
d2$time <- ave(d2$a, d2$a, FUN = seq_along)
reshape(d2[ , c("a", "b", "time")], idvar = "a", direction = "wide")

#   a b.1  b.2
# 1 1   A <NA>
# 3 3   A    B
# 5 2   B <NA>

При желании закажите 'a'.

Answer 3

Продолжая с docendo discimus's answer :

library(dplyr)
# library(tidyr)
df %>%
  count(a, b) %>%
  group_by(a) %>%
  filter(n == max(n)) %>%
  mutate(r = row_number()) %>%
  tidyr::spread(r, b) %>%
  select(-n)
# # A tibble: 3 x 3
# # Groups:   a [3]
#   a     `1`   `2`  
#   <fct> <fct> <fct>
# 1 1     A     <NA> 
# 2 2     B     <NA> 
# 3 3     A     B    

И тогда вам просто нужно переименовать столбцы.

Базовый вариант R:

reshape(do.call(rbind.data.frame, by(df, df$a, function(x) {
  tb <- table(x$b)
  tb <- tb[ tb == max(tb) ]
  data.frame(a = x$a[1], b = names(tb), r = seq_along(tb))
})), timevar = "r", idvar = "a", direction = "wide")
#     a b.1  b.2
# 1   1   A <NA>
# 2   2   B <NA>
# 3.1 3   A    B

Я разобью его, поскольку не все может быть интуитивно понятным:

Функция by возвращает list (специально отформатированный, но все еще просто список).Если мы посмотрим на один экземпляр a, давайте рассмотрим, что происходит.Я перейду к a == "3", так как это тот, который повторяется:

by(df, df$a, function(x) { browser(); 1; })
# Called from: FUN(data[x, , drop = FALSE], ...)
# Browse[1]> 
debug at #1: [1] 1
# Browse[2]> 
Called from: FUN(data[x, , drop = FALSE], ...)
# Browse[1]> 
debug at #1: [1] 1
# Browse[2]> 
Called from: FUN(data[x, , drop = FALSE], ...)
# Browse[1]> 
debug at #1: [1] 1
# Browse[2]> 
x
#    a b
# 3  3 A
# 6  3 B
# 9  3 A
# 12 3 B
# Browse[2]> 
( tb <- table(x$b) )
# A B 
# 2 2 

Хорошо, теперь у нас есть счет на b.Поймите, что здесь могло бы быть больше, скажем:

# A B C
# 2 2 1

, поэтому я собираюсь сократить этот именованный вектор до тех, которые имеют самое высокое значение:

# Browse[2]> 
( tb <- tb[ tb == max(tb) ] ) # no change here, but had there been a third value in 'b' ...
# A B 
# 2 2 

Наконец,мы хотим, чтобы by захватил data.frame (который мы можем позже объединить).Мы гарантируем, что a это одно значение, которое может быть повторено, поэтому a[1];мы убедились, что names(tb) имеет все «интересные» значения, а r является помощником для reshape, позже:

# Browse[2]> 
data.frame(a = x$a[1], b = names(tb), r = seq_along(tb))
#   a b r
# 1 3 A 1
# 2 3 B 2

Теперь, когда мы провели внутреннее исследование, давайте обернем это.

by(df, df$a, function(x) {
   tb <- table(x$b)
   tb <- tb[ tb == max(tb) ]
   data.frame(a = x$a[1], b = names(tb), r = seq_along(tb))
})
# df$a: 1
#   a b r
# 1 1 A 1
# ------------------------------------------------------------ 
# df$a: 2
#   a b r
# 1 2 B 1
# ------------------------------------------------------------ 
# df$a: 3
#   a b r
# 1 3 A 1
# 2 3 B 2

Это выглядит неловко, но если вы посмотрите под капот (с dput), вы увидите, что это просто переклассифицированный list.Теперь мы можем объединить их в один кадр с:

do.call(rbind.data.frame, by(df, df$a, function(x) {
  tb <- table(x$b)
  tb <- tb[ tb == max(tb) ]
  data.frame(a = x$a[1], b = names(tb), r = seq_along(tb))
}))
#     a b r
# 1   1 A 1
# 2   2 B 1
# 3.1 3 A 1
# 3.2 3 B 2

Кстати: для data.frame и rbind.data.frame по умолчанию они дают factor с.Если вы не хотите их, то:

do.call(rbind.data.frame, c(by(df, df$a, function(x) {
  tb <- table(x$b)
  tb <- tb[ tb == max(tb) ]
  data.frame(a = x$a[1], b = names(tb), r = seq_along(tb),
             stringsAsFactors = FALSE)
}), stringsAsFactors=FALSE))
#     a b r
# 1   1 A 1
# 2   2 B 1
# 3.1 3 A 1
# 3.2 3 B 2

И затем изменение формы.Я признаю, что это самая хрупкая (по крайней мере для меня) часть этого.Я не reshape -пользователь, я склонен к tidyr::spread или data.table::dcast, но это base-R и пока работает.Использование reshape само по себе является учебным пособием, поэтому я не буду вдаваться в подробности.Существуют многочисленные попытки предоставить более удобные инструменты для изменения формы (reshape2, tidyr, data.table все приходят на ум сразу, но вряд ли будут единственными).