В R mean()и median()есть стандартные функции, которые делают то, что вы ожидаете. mode()сообщает вам режим внутренней памяти объекта, а не значение, которое встречается чаще всего в его аргументе. Но есть ли стандартная библиотечная функция, которая реализует статистический режим для вектора (или списка)?

Еще одно решение, которое работает как с числовыми, так и символьно-факторными данными:

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)]
}

Существует пакет, 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")

Для получения дополнительной информации см эту страницу

нашел это в списке рассылки r, надеюсь, это поможет. Это также то, о чем я думал в любом случае. Вы хотите, чтобы таблица () данных, сортировать, а затем выбрать имя. Это взломано, но должно работать.

names(sort(-table(x)))[1]

Я обнаружил, что пост Кена Уильямса выше, отличный, я добавил несколько строк для учета значений 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 = "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)])

Я пока не могу голосовать, но ответ Расмуса Батха - это то, что я искал. Тем не менее, я бы немного его изменил, позволяя ограничить распределение, например, для значений только между 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)]
}

Мы понимаем, что вы можете вообще не хотеть ограничивать свой дистрибутив, поэтому установите из = - "БОЛЬШОЙ НОМЕР" в = "БОЛЬШОЙ НОМЕР"

Небольшая модификация ответа Кена Уильямса, добавление необязательных параметров 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 за упрощение.

Я написал следующий код для генерации режима.

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)

Основано на функции @ 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, я сравнил некоторые из предыдущих ответов, чтобы показать, насколько моя функция близка к производительности Кена, с условностями для различных вариантов вывода, вызывающими лишь незначительные накладные расходы:

Этот хак должен работать нормально. Дает вам значение, а также счетчик режима:

Mode <- function(x){
a = table(x) # x is a vector
return(a[which.max(a)])
}

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 (), как вы выяснили, используется для определения типа переменных ).

Это работает довольно хорошо

> a<-c(1,1,2,2,3,3,4,4,5)
> names(table(a))[table(a)==max(table(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.

a <- table([vector])

names(a[a==max(a)])

Есть несколько решений для этого. Я проверил первый и после этого написал свой. Разместите здесь, если это кому-нибудь поможет:

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))
}

Последняя строка функции просто приводит окончательное значение режима к типу исходного ввода.

Я бы использовал функцию density () для определения сглаженного максимума (возможно, непрерывного) распределения:

function(x) density(x, 2)$x[density(x, 2)$y == max(density(x, 2)$y)]

где х - сбор данных. Обратите внимание на параметры настройки функции плотности, которые регулируют сглаживание.

Хотя мне нравится простая функция Кена Уильямса, я хотел бы получить несколько режимов, если они существуют. Имея это в виду, я использую следующую функцию, которая возвращает список режимов, если несколько или один.

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)) )]
} 

Я просматривал все эти варианты и начал задумываться об их относительных характеристиках и характеристиках, поэтому я провел несколько тестов. В случае, если кому-то еще интересно то же самое, я поделюсь своими результатами здесь.

Не желая беспокоиться обо всех функциях, опубликованных здесь, я решил сосредоточиться на выборке, основанной на нескольких критериях: функция должна работать как с символьными, факторными, логическими и числовыми векторами, так и с соответствующими NA и другими проблемными значениями, и вывод должен быть «разумным», то есть не иметь числовых значений как символов или других подобных глупостей.

Я также добавил собственную функцию, основанную на той же rleидее, что и chrispy, за исключением адаптированной для более общего использования:

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. Я думаю, что это приятное прикосновение. Я также думаю, что интересно, как на некоторые функции влияет увеличение числа уникальных значений, в то время как на другие это не так сильно. Я не изучал код подробно, чтобы выяснить, почему это так, кроме устранения логической / числовой причины.

Режим не может быть полезным в любой ситуации. Таким образом, функция должна решать эту ситуацию. Попробуйте следующую функцию.

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."

Это основывается на ответе 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)))]
}

Другой простой вариант, который дает все значения, упорядоченные по частоте, заключается в использовании 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 . .frequency самого частого класса, 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"

Добавление возможного подхода data.table

library(data.table)
#for single mode
dtmode <- function(x) x[which.max(data.table::rowid(x))]

#for multiple modes
dtmodes <- function(x) x[{r <- rowid(x); r==max(r)}]

Вот несколько способов сделать это во время выполнения 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))

Можно попробовать следующую функцию:

1. преобразовать числовые значения в коэффициент
2. используйте summary (), чтобы получить таблицу частот
3. режим возврата индекс, частота которого является наибольшей
4. преобразовать коэффициент обратно в числовое значение, даже если имеется более 1 режима, эта функция работает хорошо!

mode <- function(x){
  y <- as.factor(x)
  freq <- summary(y)
  mode <- names(freq)[freq[names(freq)] == max(freq)]
  as.numeric(mode)
}

Режим расчета в основном для факторной переменной, тогда мы можем использовать

labels(table(HouseVotes84$V1)[as.numeric(labels(max(table(HouseVotes84$V1))))])

HouseVotes84 - это набор данных, доступный в пакете mlbench.

это даст максимальное значение метки. это проще использовать встроенными функциями без написания функции.

Мне кажется, что если у коллекции есть режим, то его элементы могут быть сопоставлены один к одному с натуральными числами. Таким образом, проблема поиска режима сводится к созданию такого сопоставления, нахождению режима сопоставленных значений, а затем сопоставлению некоторых элементов в коллекции. (Работа с NAпроисходит на этапе отображения).

У меня есть histogramфункция, которая работает по аналогичному принципу. (Специальные функции и операторы, используемые в представленном здесь коде, должны быть определены в Shapiro и / или neatOveRse . Части Shapiro и neatOveRse, дублированные в данном документе, дублируются с разрешения; дублированные фрагменты могут использоваться в соответствии с условиями этого сайта. ) R псевдокод для histogramis

.histogram <- function (i)
        if (i %|% is.empty) integer() else
        vapply2(i %|% max %|% seqN, `==` %<=% i %O% sum)

histogram <- function(i) i %|% rmna %|% .histogram

(Специальные бинарные операторы выполняют конвейер , карри и композицию ) У меня также есть maxlocфункция, которая похожа which.max, но возвращает все абсолютные максимумы вектора. R псевдокод для maxlocis

FUNloc <- function (FUN, x, na.rm=F)
        which(x == list(identity, rmna)[[na.rm %|% index.b]](x) %|% FUN)

maxloc <- FUNloc %<=% max

minloc <- FUNloc %<=% min # I'M THROWING IN minloc TO EXPLAIN WHY I MADE FUNloc

затем

imode <- histogram %O% maxloc

а также

x %|% map %|% imode %|% unmap

будет вычислять режим любой коллекции, при условии определения соответствующих mapфункций -ping и unmap-ping.