Есть ли встроенная функция для нахождения режима?
В R, mean() а также median() стандартные функции, которые делают то, что вы ожидаете. mode() сообщает вам режим внутренней памяти объекта, а не значение, которое встречается чаще всего в его аргументе. Но есть ли стандартная библиотечная функция, которая реализует статистический режим для вектора (или списка)?
37 ответов
Еще одно решение, которое работает как с числовыми, так и символьно-факторными данными:
Mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
На моей маленькой машинке, которая может генерировать и находить режим 10M-целочисленного вектора примерно за полсекунды.
Если в вашем наборе данных может быть несколько режимов, вышеуказанное решение использует тот же подход, что и which.maxи возвращает первое появившееся значение набора режимов. Чтобы вернуть все режимы, используйте этот вариант (из @digEmAll в комментариях):
Modes <- function(x) {
ux <- unique(x)
tab <- tabulate(match(x, ux))
ux[tab == max(tab)]
}
Нашел это в списке рассылки r, надеюсь, это поможет. Это также то, о чем я думал в любом случае. Вы хотите, чтобы таблица () данных, сортировать, а затем выбрать имя. Это взломано, но должно работать.
names(sort(-table(x)))[1]
Есть пакет modeest которые обеспечивают оценки режима одномерных унимодальных (и иногда мультимодальных) данных и значений режимов обычных вероятностных распределений.
mySamples <- c(19, 4, 5, 7, 29, 19, 29, 13, 25, 19)
library(modeest)
mlv(mySamples, method = "mfv")
Mode (most likely value): 19
Bickel's modal skewness: -0.1
Call: mlv.default(x = mySamples, method = "mfv")
Для получения дополнительной информации см эту страницу
Я нашел пост Кена Уильямса выше, отличный, я добавил несколько строк, чтобы учесть значения NA и сделал его функцией для удобства.
Mode <- function(x, na.rm = FALSE) {
if(na.rm){
x = x[!is.na(x)]
}
ux <- unique(x)
return(ux[which.max(tabulate(match(x, ux)))])
}
Быстрый и грязный способ оценки режима вектора чисел, который, по вашему мнению, исходит из непрерывного одномерного распределения (например, нормального распределения), определяет и использует следующую функцию:
estimate_mode <- function(x) {
d <- density(x)
d$x[which.max(d$y)]
}
Затем, чтобы получить оценку режима:
x <- c(5.8, 5.6, 6.2, 4.1, 4.9, 2.4, 3.9, 1.8, 5.7, 3.2)
estimate_mode(x)
## 5.439788
Следующая функция поставляется в трех формах:
method = "mode" [по умолчанию]: вычисляет режим для унимодального вектора, иначе возвращает NA
method = "nmodes": вычисляет количество мод в векторе
method = "mode": перечисляет все моды для унимодального или полимодального вектора
modeav <- function (x, method = "mode", na.rm = FALSE)
{
x <- unlist(x)
if (na.rm)
x <- x[!is.na(x)]
u <- unique(x)
n <- length(u)
#get frequencies of each of the unique values in the vector
frequencies <- rep(0, n)
for (i in seq_len(n)) {
if (is.na(u[i])) {
frequencies[i] <- sum(is.na(x))
}
else {
frequencies[i] <- sum(x == u[i], na.rm = TRUE)
}
}
#mode if a unimodal vector, else NA
if (method == "mode" | is.na(method) | method == "")
{return(ifelse(length(frequencies[frequencies==max(frequencies)])>1,NA,u[which.max(frequencies)]))}
#number of modes
if(method == "nmode" | method == "nmodes")
{return(length(frequencies[frequencies==max(frequencies)]))}
#list of all modes
if (method == "modes" | method == "modevalues")
{return(u[which(frequencies==max(frequencies), arr.ind = FALSE, useNames = FALSE)])}
#error trap the method
warning("Warning: method not recognised. Valid methods are 'mode' [default], 'nmodes' and 'modes'")
return()
}
Здесь другое решение:
freq <- tapply(mySamples,mySamples,length)
#or freq <- table(mySamples)
as.numeric(names(freq)[which.max(freq)])
Основан на функции @Chris для расчета режима или связанных метрик, однако для расчета частот используется метод Кена Уильямса. Это обеспечивает исправление для случая отсутствия режимов вообще (все элементы одинаково часты), а некоторые более читабельны. method имена.
Mode <- function(x, method = "one", na.rm = FALSE) {
x <- unlist(x)
if (na.rm) {
x <- x[!is.na(x)]
}
# Get unique values
ux <- unique(x)
n <- length(ux)
# Get frequencies of all unique values
frequencies <- tabulate(match(x, ux))
modes <- frequencies == max(frequencies)
# Determine number of modes
nmodes <- sum(modes)
nmodes <- ifelse(nmodes==n, 0L, nmodes)
if (method %in% c("one", "mode", "") | is.na(method)) {
# Return NA if not exactly one mode, else return the mode
if (nmodes != 1) {
return(NA)
} else {
return(ux[which(modes)])
}
} else if (method %in% c("n", "nmodes")) {
# Return the number of modes
return(nmodes)
} else if (method %in% c("all", "modes")) {
# Return NA if no modes exist, else return all modes
if (nmodes > 0) {
return(ux[which(modes)])
} else {
return(NA)
}
}
warning("Warning: method not recognised. Valid methods are 'one'/'mode' [default], 'n'/'nmodes' and 'all'/'modes'")
}
Так как он использует метод Кена для расчета частот, производительность также оптимизируется, используя пост AkselA, я сравнил некоторые из предыдущих ответов, чтобы показать, насколько моя функция близка к производительности Кена, с условными значениями для различных вариантов вывода, вызывающими лишь незначительные накладные расходы: 
Небольшая модификация ответа Кена Уильямса, добавление необязательных параметров na.rm а также return_multiple,
В отличие от ответов, основанных на names()этот ответ поддерживает тип данных x в возвращаемом значении (ях).
stat_mode <- function(x, return_multiple = TRUE, na.rm = FALSE) {
if(na.rm){
x <- na.omit(x)
}
ux <- unique(x)
freq <- tabulate(match(x, ux))
mode_loc <- if(return_multiple) which(freq==max(freq)) else which.max(freq)
return(ux[mode_loc])
}
Чтобы показать, что он работает с необязательными параметрами и поддерживает тип данных:
foo <- c(2L, 2L, 3L, 4L, 4L, 5L, NA, NA)
bar <- c('mouse','mouse','dog','cat','cat','bird',NA,NA)
str(stat_mode(foo)) # int [1:3] 2 4 NA
str(stat_mode(bar)) # chr [1:3] "mouse" "cat" NA
str(stat_mode(bar, na.rm=T)) # chr [1:2] "mouse" "cat"
str(stat_mode(bar, return_mult=F, na.rm=T)) # chr "mouse"
Спасибо @Frank за упрощение.
Общая функция fmodeв пакете collapse, который теперь доступен в CRAN, реализует режим на основе C++, основанный на хешировании индекса. Это значительно быстрее, чем любой из вышеперечисленных подходов. Он поставляется с методами для векторов, матриц, data.frames и dplyr-сгруппированных таблиц. Синтаксис:
fmode(x, g = NULL, w = NULL, ...)
где x может быть одним из перечисленных выше объектов, g предоставляет необязательный вектор группировки или список векторов группировки (для расчетов в режиме группировки, также выполняемых в C++), и w(необязательно) предоставляет числовой вектор веса. В методе сгруппированных таблиц нетg аргумент, вы можете сделать data %>% group_by(idvar) %>% fmode.
Я пока не могу голосовать, но ответ Расмуса Батха - это то, что я искал. Тем не менее, я бы немного его изменил, что позволило бы ограничить распределение, например, для значений только между 0 и 1.
estimate_mode <- function(x,from=min(x), to=max(x)) {
d <- density(x, from=from, to=to)
d$x[which.max(d$y)]
}
Мы понимаем, что вы можете вообще не хотеть ограничивать свой дистрибутив, поэтому установите от =-"БОЛЬШОЙ НОМЕР" до = "БОЛЬШОЙ НОМЕР"
Я написал следующий код для генерации режима.
MODE <- function(dataframe){
DF <- as.data.frame(dataframe)
MODE2 <- function(x){
if (is.numeric(x) == FALSE){
df <- as.data.frame(table(x))
df <- df[order(df$Freq), ]
m <- max(df$Freq)
MODE1 <- as.vector(as.character(subset(df, Freq == m)[, 1]))
if (sum(df$Freq)/length(df$Freq)==1){
warning("No Mode: Frequency of all values is 1", call. = FALSE)
}else{
return(MODE1)
}
}else{
df <- as.data.frame(table(x))
df <- df[order(df$Freq), ]
m <- max(df$Freq)
MODE1 <- as.vector(as.numeric(as.character(subset(df, Freq == m)[, 1])))
if (sum(df$Freq)/length(df$Freq)==1){
warning("No Mode: Frequency of all values is 1", call. = FALSE)
}else{
return(MODE1)
}
}
}
return(as.vector(lapply(DF, MODE2)))
}
Давай попробуем:
MODE(mtcars)
MODE(CO2)
MODE(ToothGrowth)
MODE(InsectSprays)
Этот хак должен работать нормально. Дает вам значение, а также счетчик режима:
Mode <- function(x){
a = table(x) # x is a vector
return(a[which.max(a)])
}
Это основывается на ответе jprockbelly, добавляя ускорение для очень коротких векторов. Это полезно при применении режима к data.frame или для данных с большим количеством небольших групп:
Mode <- function(x) {
if ( length(x) <= 2 ) return(x[1])
if ( anyNA(x) ) x = x[!is.na(x)]
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
Это работает довольно хорошо
> a<-c(1,1,2,2,3,3,4,4,5)
> names(table(a))[table(a)==max(table(a))]
Ниже приведен код, который можно использовать для поиска режима векторной переменной в R.
a <- table([vector])
names(a[a==max(a)])
Вот функция для поиска режима:
mode <- function(x) {
unique_val <- unique(x)
counts <- vector()
for (i in 1:length(unique_val)) {
counts[i] <- length(which(x==unique_val[i]))
}
position <- c(which(counts==max(counts)))
if (mean(counts)==max(counts))
mode_x <- 'Mode does not exist'
else
mode_x <- unique_val[position]
return(mode_x)
}
R имеет так много дополнительных пакетов, что некоторые из них вполне могут обеспечить [статистический] режим числового списка / серии / вектора.
Однако в стандартной библиотеке R, похоже, нет такого встроенного метода! Один из способов обойти это - использовать некоторую конструкцию, подобную следующей (и превратить ее в функцию, если вы часто используете...):
mySamples <- c(19, 4, 5, 7, 29, 19, 29, 13, 25, 19)
tabSmpl<-tabulate(mySamples)
SmplMode<-which(tabSmpl== max(tabSmpl))
if(sum(tabSmpl == max(tabSmpl))>1) SmplMode<-NA
> SmplMode
[1] 19
Для большего списка образцов следует рассмотреть возможность использования временной переменной для значения max(tabSmpl) (я не знаю, что R автоматически оптимизирует это)
Ссылка: см. "Как насчет медианы и моды?" в этом уроке KickStarting R
Это, кажется, подтверждает, что (по крайней мере, на момент написания этого урока) в R нет функции mode (ну... mode(), как вы выяснили, используется для определения типа переменных).
Есть несколько решений для этого. Я проверил первый и после этого написал свой. Размещение здесь, если это кому-нибудь поможет:
Mode <- function(x){
y <- data.frame(table(x))
y[y$Freq == max(y$Freq),1]
}
Давайте проверим это на нескольких примерах. Я беру iris набор данных. Давайте проверим числовые данные
> Mode(iris$Sepal.Length)
[1] 5
что вы можете проверить это правильно.
Теперь единственное нечисловое поле в наборе данных радужной оболочки (Виды) не имеет режима. Давайте проверим на нашем собственном примере
> test <- c("red","red","green","blue","red")
> Mode(test)
[1] red
РЕДАКТИРОВАТЬ
Как упоминалось в комментариях, пользователь может захотеть сохранить тип ввода. В этом случае функцию режима можно изменить на:
Mode <- function(x){
y <- data.frame(table(x))
z <- y[y$Freq == max(y$Freq),1]
as(as.character(z),class(x))
}
Последняя строка функции просто приводит окончательное значение режима к типу исходного ввода.
Хотя мне нравится простая функция Кена Уильямса, я бы хотел получить несколько режимов, если они существуют. Имея это в виду, я использую следующую функцию, которая возвращает список режимов, если несколько или один.
rmode <- function(x) {
x <- sort(x)
u <- unique(x)
y <- lapply(u, function(y) length(x[x==y]))
u[which( unlist(y) == max(unlist(y)) )]
}
Режим не может быть полезным в любой ситуации. Таким образом, функция должна решать эту ситуацию. Попробуйте следующую функцию.
Mode <- function(v) {
# checking unique numbers in the input
uniqv <- unique(v)
# frquency of most occured value in the input data
m1 <- max(tabulate(match(v, uniqv)))
n <- length(tabulate(match(v, uniqv)))
# if all elements are same
same_val_check <- all(diff(v) == 0)
if(same_val_check == F){
# frquency of second most occured value in the input data
m2 <- sort(tabulate(match(v, uniqv)),partial=n-1)[n-1]
if (m1 != m2) {
# Returning the most repeated value
mode <- uniqv[which.max(tabulate(match(v, uniqv)))]
} else{
mode <- "Two or more values have same frequency. So mode can't be calculated."
}
} else {
# if all elements are same
mode <- unique(v)
}
return(mode)
}
Выход,
x1 <- c(1,2,3,3,3,4,5)
Mode(x1)
# [1] 3
x2 <- c(1,2,3,4,5)
Mode(x2)
# [1] "Two or more varibles have same frequency. So mode can't be calculated."
x3 <- c(1,1,2,3,3,4,5)
Mode(x3)
# [1] "Two or more values have same frequency. So mode can't be calculated."
Я бы использовал функцию density() для определения сглаженного максимума (возможно, непрерывного) распределения:
function(x) density(x, 2)$x[density(x, 2)$y == max(density(x, 2)$y)]
где х - сбор данных. Обратите внимание на параметр настройки функции плотности, которая регулирует сглаживание.
Я просматривал все эти варианты и начал задумываться об их относительных характеристиках и характеристиках, поэтому я провел несколько тестов. В случае, если кому-то еще интересно то же самое, я поделюсь своими результатами здесь.
Не желая беспокоиться обо всех функциях, опубликованных здесь, я решил сосредоточиться на выборке, основанной на нескольких критериях: функция должна работать как с символьными, факторными, логическими и числовыми векторами, так и с соответствующими NA и другими проблемными значениями; и вывод должен быть "разумным", то есть не иметь числовых значений как символов или других подобных глупостей.
Я также добавил свою собственную функцию, которая основана на том же rle Идея как chrispy's, за исключением адаптированных для более общего использования:
library(magrittr)
Aksel <- function(x, freq=FALSE) {
z <- 2
if (freq) z <- 1:2
run <- x %>% as.vector %>% sort %>% rle %>% unclass %>% data.frame
colnames(run) <- c("freq", "value")
run[which(run$freq==max(run$freq)), z] %>% as.vector
}
set.seed(2)
F <- sample(c("yes", "no", "maybe", NA), 10, replace=TRUE) %>% factor
Aksel(F)
# [1] maybe yes
C <- sample(c("Steve", "Jane", "Jonas", "Petra"), 20, replace=TRUE)
Aksel(C, freq=TRUE)
# freq value
# 7 Steve
В итоге я запустил пять функций на двух наборах тестовых данных через microbenchmark, Названия функций относятся к их соответствующим авторам:
Функция Криса была установлена на method="modes" а также na.rm=TRUE по умолчанию, чтобы сделать его более сопоставимым, но кроме этого были использованы функции, представленные здесь их авторами.
Только в отношении скорости версия Kens выигрывает легко, но она также является единственной из них, которая сообщает только об одном режиме, независимо от того, сколько их на самом деле. Как это часто бывает, существует компромисс между скоростью и универсальностью. В method="mode", Версия Криса вернет значение, если есть один режим, иначе NA. Я думаю, что это приятное прикосновение. Я также думаю, что интересно, как на некоторые функции влияет увеличение числа уникальных значений, в то время как на другие это не так сильно. Я не изучал код подробно, чтобы выяснить, почему это так, кроме устранения логической / числовой причины.
Другой простой вариант, который дает все значения, упорядоченные по частоте, заключается в использовании rle:
df = as.data.frame(unclass(rle(sort(mySamples))))
df = df[order(-df$lengths),]
head(df)
Другое возможное решение:
Mode <- function(x) {
if (is.numeric(x)) {
x_table <- table(x)
return(as.numeric(names(x_table)[which.max(x_table)]))
}
}
Использование:
set.seed(100)
v <- sample(x = 1:100, size = 1000000, replace = TRUE)
system.time(Mode(v))
Выход:
user system elapsed
0.32 0.00 0.31
Я считаю, что ваши наблюдения - это классы из действительных чисел, и вы ожидаете, что режим будет равен 2,5, когда ваши наблюдения будут 2, 2, 3 и 3, тогда вы можете оценить режим с mode = l1 + i * (f1-f0) / (2f1 - f0 - f2) где l1.. нижний предел наиболее часто встречающегося класса, f1.. частота наиболее часто встречающегося класса, f0.. частота классов перед наиболее часто встречающимся классом, f2.. частота классов после наиболее часто встречающегося класса и интервал i..Class, как указано, например, в 1, 2, 3:
#Small Example
x <- c(2,2,3,3) #Observations
i <- 1 #Class interval
z <- hist(x, breaks = seq(min(x)-1.5*i, max(x)+1.5*i, i), plot=F) #Calculate frequency of classes
mf <- which.max(z$counts) #index of most frequent class
zc <- z$counts
z$breaks[mf] + i * (zc[mf] - zc[mf-1]) / (2*zc[mf] - zc[mf-1] - zc[mf+1]) #gives you the mode of 2.5
#Larger Example
set.seed(0)
i <- 5 #Class interval
x <- round(rnorm(100,mean=100,sd=10)/i)*i #Observations
z <- hist(x, breaks = seq(min(x)-1.5*i, max(x)+1.5*i, i), plot=F)
mf <- which.max(z$counts)
zc <- z$counts
z$breaks[mf] + i * (zc[mf] - zc[mf-1]) / (2*zc[mf] - zc[mf-1] - zc[mf+1]) #gives you the mode of 99.5
Если вам нужен самый частый уровень и у вас более одного наиболее частого уровня, вы можете получить их все, например:
x <- c(2,2,3,5,5)
names(which(max(table(x))==table(x)))
#"2" "5"
Вот несколько способов сделать это во время работы Theta(N)
from collections import defaultdict
def mode1(L):
counts = defaultdict(int)
for v in L:
counts[v] += 1
return max(counts,key=lambda x:counts[x])
def mode2(L):
vals = set(L)
return max(vals,key=lambda x: L.count(x))
def mode3(L):
return max(set(L), key=lambda x: L.count(x))
Если вы спросите встроенную функцию в R, возможно, вы найдете ее в упаковке pracma. Внутри этого пакета есть функция под названием Mode.
Режим расчета в основном для факторной переменной, тогда мы можем использовать
labels(table(HouseVotes84$V1)[as.numeric(labels(max(table(HouseVotes84$V1))))])
HouseVotes84 - это набор данных, доступный в пакете mlbench.
это даст максимальное значение метки. это проще использовать встроенными функциями без написания функции.
Добавление в raster::modal() как вариант, хотя обратите внимание, что raster - здоровенный пакет, и его, возможно, не стоит устанавливать, если вы не занимаетесь геопространственной работой.
Исходный код можно было извлечь из https://github.com/rspatial/raster/blob/master/src/modal.cpp и https://github.com/rspatial/raster/blob/master/R/modal.R в личный пакет R для тех, кто особенно увлечен.