У R mean()і median()є стандартні функції, які виконують те, що ви очікували. mode()повідомляє вам внутрішній режим зберігання об’єкта, а не значення, яке найбільше зустрічається в його аргументі. Але чи є стандартна функція бібліотеки, яка реалізує статистичний режим для вектора (або списку)?

Ще одне рішення, яке працює як для числових даних, так і для символів / факторів:

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

На моїй вигадливій маленькій машинці, яка може генерувати та знаходити режим 10-цілого цілого вектора приблизно за півсекунди.

Якщо у вашому наборі даних може бути декілька режимів, вищевказане рішення використовує той самий підхід 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": обчислює кількість режимів у векторному
методі = " 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)

На основі функції @ Кріса обчислювати режим або пов'язані з ним показники, однак використовуючи метод Кена Вільямса для обчислення частот. Цей виправляє випадок відсутності режимів взагалі (усі елементи однаково часті) та ще декількох читаних 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
Це, мабуть, підтверджує, що (принаймні, на час написання цього уроку) функція mode в R (ну ... режим (), як ви з'ясували, використовується для затвердження типу змінних. ).

Це працює досить добре

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

Нижче наведено код, за допомогою якого можна знайти режим векторної змінної у Р.

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

EDIT

Як зазначено в коментарях, користувач може захотіти зберегти тип введення. У такому випадку функцію режиму можна змінити на:

Mode <- function(x){
  y <- data.frame(table(x))
  z <- y[y$Freq == max(y$Freq),1]
  as(as.character(z),class(x))
}

Останній рядок функції просто примушує кінцеве значення режиму до типу вихідного вводу.

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

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

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

Я переглядав усі ці варіанти і почав цікавитись їх відносними особливостями та характеристиками, тому зробив кілька тестів. Якщо комусь цікаво те саме, я ділюся своїми результатами тут.

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

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

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 або datatable з великою кількістю малих груп:

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 . .частота найчастішого класу, f0 ..частота класів перед найчастішим класом, f2 ..частота класів після найбільш частого класу і i .. Інтервал класу, як задано, наприклад, в 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"

Додавання можливого підходу до таблиць даних

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 псевдокод для histogramє

.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 псевдокод для maxlocє

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.