Как подсчитать буквы в строке и вернуть самую высокую встречающуюся букву для строк во фрейме данных в R

#r

#r

Вопрос:

У меня есть столбец во фрейме данных, который состоит из букв, описывающих направления ветра. Мне нужно найти наиболее распространенное направление для каждой строки, которое включало бы подсчет количества вхождений каждой буквы, а затем выбор буквы, которая была наиболее распространенной. Это пример фрейма данных:

 structure(list(Day = c("15", "16", "17", "18", "19", "20"), Month = structure(c(4L, 
4L, 4L, 4L, 4L, 4L), .Label = c("Dec", "Nov", "Oct", "Sep"), class = "factor"), 
    Year = structure(c(2L, 2L, 2L, 2L, 2L, 2L), .Label = c("2012", 
    "2013", "2014", "2015", "2018", "2019", "2020"), class = "factor"), 
    Time = structure(c(10L, 10L, 10L, 10L, 10L, 10L), .Label = c("1-2pm", 
    "10-11am", "11-12am", "12-1pm", "2-3pm", "3-4pm", "4-5pm", 
    "5-6pm", "7-8am", "8-9am", "9-10am"), class = "factor"), 
    Direction_Abrev = c("S-SE", "S-SE", "SW-S", "W-SE", "W-SW", 
    "SW-S")), row.names = c(NA, 6L), class = "data.frame")
 

Я бы хотел, чтобы результирующий фрейм данных был следующим:

   Day Month Year  Time Direction_Abrev
1  15   Sep 2013 8-9am              S
2  16   Sep 2013 8-9am              S
3  17   Sep 2013 8-9am              S
4  18   Sep 2013 8-9am           W-SE
5  19   Sep 2013 8-9am              W
6  20   Sep 2013 8-9am              S
 

это возвращает наиболее распространенную букву. Существует проблема (например, строка 4), где все буквы одинаково распространены. В этих случаях я хотел бы вернуть исходное значение, если это возможно.
Заранее спасибо.

Ответ №1:

 sapply(dat$Direction_Abrev, function(s) {
  counts <- sort(table(setdiff(strsplit(s, ""), "-")), decreasing = TRUE)
  if (length(counts) < 2 || counts[1] == counts[2]) s else names(counts)[1]
})
#   S-SE   S-SE   SW-S   W-SE   W-SW   SW-S 
#    "S"    "S"    "S" "W-SE"    "W"    "S" 
 

Ответ №2:

Вот базовый вариант R, использующий strsplit intersect

 transform(
  df,
  Direction_Abrev = unlist(
    ifelse(
      lengths(
        v <- sapply(
          strsplit(Direction_Abrev, "-"),
          function(x) do.call(intersect, strsplit(x, ""))
        )
      ),
      v,
      Direction_Abrev
    )
  )
)
 

что дает

   Day Month Year  Time Direction_Abrev
1  15   Sep 2013 8-9am               S
2  16   Sep 2013 8-9am               S
3  17   Sep 2013 8-9am               S
4  18   Sep 2013 8-9am            W-SE
5  19   Sep 2013 8-9am               W
6  20   Sep 2013 8-9am               S