R'de mean()ve median()beklediğiniz şeyi yapan standart işlevlerdir. mode()argümanında en çok meydana gelen değeri değil, nesnenin dahili depolama modunu belirtir. Ancak bir vektör (veya liste) için istatistiksel modu uygulayan standart bir kütüphane işlevi var mı?

Hem sayısal hem de karakter / faktör verileri için çalışan bir çözüm daha:

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

Dinky küçük makinemde, yaklaşık yarım saniyede 10M tam sayı vektörünün modunu oluşturabilir ve bulabilir.

Veri kümenizde birden fazla mod olabilirse, yukarıdaki çözüm aynı yaklaşımı benimser which.maxve mod grubunun ilk görünen değerini döndürür . Tüm modları döndürmek için bu değişkeni kullanın (yorumlarda @digEmAll öğesinden):

Modes <- function(x) {
  ux <- unique(x)
  tab <- tabulate(match(x, ux))
  ux[tab == max(tab)]
}

modeestTek değişkenli unimodal (ve bazen multimodal) veri ve normal olasılık dağılımlarının modlarının değerlerini tahmin eden bir paket vardır.

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

Daha fazla bilgi için bu sayfaya bakın

bunu r posta listesinde buldum, umarım faydalıdır. Zaten ben de öyle düşünüyordum. Verileri tablo haline getirmek (), sıralamak ve ardından ilk adı seçmek isteyeceksiniz. Keskin ama işe yarıyor.

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

Yukarıdaki Ken Williams yazısının harika olduğunu gördüm, NA değerlerini hesaba katmak için birkaç satır ekledim ve rahatlık için bir işlev haline getirdim.

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

Sürekli tek değişkenli bir dağılımdan (örneğin normal bir dağılım) geldiğini düşündüğünüz bir sayı vektörünün modunu tahmin etmenin hızlı ve kirli bir yolu aşağıdaki işlevi tanımlamak ve kullanmaktır:

estimate_mode <- function(x) {
  d <- density(x)
  d$x[which.max(d$y)]
}

Ardından mod tahminini almak için:

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

Aşağıdaki işlev üç biçimde gelir:

method = "mode" [varsayılan]: tek modlu bir vektör için modu hesaplar, aksi halde bir NA
yöntemi döndürür = "nmodes": vektör
yöntemindeki mod sayısını hesaplar = "mod": tek modlu veya çok modlu için tüm modları listeler vektör

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

İşte başka bir çözüm:

freq <- tapply(mySamples,mySamples,length)
#or freq <- table(mySamples)
as.numeric(names(freq)[which.max(freq)])

Henüz oy kullanamıyorum ama Rasmus Bååth'ın cevabı aradığım şeydi. Ancak, örneğin sadece 0 ve 1 arasındaki fro değerlerinin dağılımını engellemeye izin verecek şekilde biraz değiştiririm.

estimate_mode <- function(x,from=min(x), to=max(x)) {
  d <- density(x, from=from, to=to)
  d$x[which.max(d$y)]
}

Tüm dağıtımlarınızda kısıtlama yapmak istemeyeceğinizin farkındayız, ardından = - "BÜYÜK NUMARALI" olarak = "BÜYÜK NUMARALI" olarak ayarlayın

Ken Williams'ın cevabında küçük bir değişiklik, isteğe bağlı parametreler na.rmve return_multiple.

Bu yanıtlara dayanarak names(), bu cevap xdöndürülen değer (ler) in veri türünü korur .

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

Opsiyonel parametrelerle çalıştığını ve veri türünü koruduğunu göstermek için:

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"

Sadeleştirme için @Frank'e teşekkürler.

Modu oluşturmak için aşağıdaki kodu yazdım.

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

Hadi deneyelim:

MODE(mtcars)
MODE(CO2)
MODE(ToothGrowth)
MODE(InsectSprays)

@ Chris'in modu veya ilgili metrikleri hesaplama işlevini temel alır, ancak frekansları hesaplamak için Ken Williams yöntemini kullanır. Bu, hiç mod olmaması durumunda (tüm öğeler eşit sıklıkta) ve bazı daha okunabilir methodadlar için bir düzeltme sağlar .

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

Frekansları hesaplamak için Ken'in yöntemini kullandığı için, performans da optimize edilmiştir, AkselA'nın gönderisini kullanarak, önceki yanıtların bazılarını, işlevimin Ken'in performansına ne kadar yakın olduğunu göstermek için karşılaştırdım, çeşitli çıkış seçeneklerinin koşulları sadece küçük ek yüke neden oldu:

Bu kesmek iyi çalışmalı. Modun yanı sıra değeri de verir:

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

R o kadar çok sayıda eklenti paketine sahiptir ki, bazıları sayısal bir liste / seri / vektörün [istatistiksel] modunu iyi sağlayabilir.

Ancak R'nin standart kütüphanesinin böyle yerleşik bir yöntemi yok gibi görünüyor! Bu soruna geçici bir çözüm bulmak için aşağıdaki gibi bir yapı kullanmak (ve sık kullanıyorsanız bunu bir işleve dönüştürmek ...):

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

Daha büyük örnek listesi için, bir max (tabSmpl) değeri için geçici bir değişken kullanmayı düşünmelisiniz (R'nin bunu otomatik olarak optimize edeceğini bilmiyorum)

Referans: bkz. "Medyan ve mod nasıl?" Bu KickStarting R dersinde
Bu, (en azından bu dersin yazılmasından itibaren), değişkenlerin türünü iddia etmek için kullanıldığını öğrendiğiniz gibi R'de (iyi ... modu () bir mod işlevi olmadığını doğrulamaktadır. ).

Bu gayet iyi çalışıyor

> a<-c(1,1,2,2,3,3,4,4,5)
> names(table(a))[table(a)==max(table(a))]

Modu bulmak için bir fonksiyon:

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şağıda R'de bir vektör değişkeninin modunu bulmak için kullanılabilecek kod bulunmaktadır.

a <- table([vector])

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

Bunun için birden fazla çözüm var. İlkini kontrol ettim ve bundan sonra kendim yazdım. Herhangi birine yardımcı olursa buraya gönderme:

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

Birkaç örnekle test edelim. irisVeri setini alıyorum . Sayısal verilerle test yapalım

> Mode(iris$Sepal.Length)
[1] 5

doğru olduğunu doğrulayabilirsiniz.

Artık iris veri kümesindeki (Türler) sayısal olmayan tek alanın modu yoktur. Kendi örneğimizle test edelim

> test <- c("red","red","green","blue","red")
> Mode(test)
[1] red

DÜZENLE

Yorumlarda belirtildiği gibi, kullanıcı giriş türünü korumak isteyebilir. Bu durumda mod işlevi şu şekilde değiştirilebilir:

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

Fonksiyonun son satırı, nihai mod değerini orijinal girişin tipine zorlar.

Ben (muhtemelen sürekli) dağılımın düzeltilmiş bir maksimum tanımlamak için density () işlevini kullanabilirsiniz:

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

burada x veri toplamadır. Yumuşatmayı düzenleyen yoğunluk fonksiyonunun ayar parametresine dikkat edin.

Ken Williams'ın basit işlevini sevsem de, varsa çoklu modları almak istiyorum. Bunu göz önünde bulundurarak, çoklu veya tekli modların bir listesini döndüren aşağıdaki işlevi kullanıyorum.

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

Tüm bu seçenekleri araştırıyordum ve göreceli özelliklerini ve performanslarını merak etmeye başladım, bu yüzden bazı testler yaptım. Başka birinin aynı şeyi merak etmesi durumunda, sonuçlarımı burada paylaşıyorum.

Burada yayınlanan tüm işlevler hakkında rahatsız etmek istemiyorum, birkaç kritere dayanan bir örneğe odaklanmayı seçtim: işlev hem karakter, faktör, mantıksal ve sayısal vektörler üzerinde çalışmalı, NA'lar ve diğer sorunlu değerlerle uygun şekilde ilgilenmeli, ve çıktı 'mantıklı' olmalıdır, yani karakter ya da diğer benzerlik gibi sayısallar olmamalıdır.

Ayrıca rle, daha genel kullanım için uyarlanmış olanlar dışında, chrispy ile aynı fikre dayanan kendi fonksiyonumu ekledim :

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

Sonunda iki test verisi setinde beş fonksiyon çalıştırdım microbenchmark. İşlev adları ilgili yazarlarına başvurur:

Chris'in işlevi method="modes"vena.rm=TRUE varsayılan olarak kendi yazarları tarafından burada sunulan olarak işlev kullanıldı daha o daha karşılaştırılabilir, ancak diğer yapmaya.

Tek başına hız söz konusu olduğunda, Kens versiyonu kolayca kazanır, ancak gerçekten kaç tane olursa olsun, sadece bir modu rapor edecek olanlardan sadece biridir. Çoğu zaman olduğu gibi, hız ve çok yönlülük arasında bir denge vardır. İçinde method="mode"Chris'in sürümü bir mod, başka bir NA varsa bir değer döndürür. Bence bu hoş bir dokunuş. Ayrıca, bazı fonksiyonların artan sayıda benzersiz değerden nasıl etkilendiğini ilginç bulurken, diğerleri neredeyse o kadar değil. Nedeni olarak mantıksal / sayısal ortadan kaldırmak dışında neden olduğunu anlamak için kodu ayrıntılı olarak inceledim.

Mod her durumda kullanışlı olamaz. Bu nedenle işlev bu durumu ele almalıdır. Aşağıdaki işlevi deneyin.

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

Çıktı,

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

Bu, çok kısa vektörler için bir hız ekleyerek jprockbelly'nin cevabına dayanır. Bu, bir data.frame'e veya çok sayıda küçük grup içeren datatable'a mod uygularken yararlıdır:

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

Sıklıkla sıralanan tüm değerleri veren başka bir basit seçenek kullanmaktır rle:

df = as.data.frame(unclass(rle(sort(mySamples))))
df = df[order(-df$lengths),]
head(df)

Başka bir olası çözüm:

Mode <- function(x) {
    if (is.numeric(x)) {
        x_table <- table(x)
        return(as.numeric(names(x_table)[which.max(x_table)]))
    }
}

Kullanımı:

set.seed(100)
v <- sample(x = 1:100, size = 1000000, replace = TRUE)
system.time(Mode(v))

Çıktı:

   user  system elapsed 
   0.32    0.00    0.31 

Ben senin gözlemler harf sınıfları arasından Gerçek sayılar ve bekliyoruz modu Gözlemleriniz 2, 2, 3 ve 3 sonra da birlikte modunu tahmin olabilir olduğunda 2.5 olması mode = l1 + i * (f1-f0) / (2f1 - f0 - f2)nerede l1 en sık sınıfın ..lower sınırı, f1 . . en sık sınıfın sıklığı, f0 .. en sık sınıftan önce sınıfların sıklığı, f2 .. en sık sınıftan sonra sınıfların sıklığı ve i .. örneğin 1 , 2 , 3'te verilen sınıf aralığı :

#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

Eğer istediğiniz en sık düzeyini ve sahip birden fazla onlarla mesela ile tüm alabilirsiniz en sık seviyede:

x <- c(2,2,3,5,5)
names(which(max(table(x))==table(x)))
#"2" "5"

Olası bir data.table yaklaşımı ekleme

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

İşte Theta (N) çalışma zamanında yapmanın birkaç yolu

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

Aşağıdaki işlevi deneyebiliriz:

1. sayısal değerleri faktöre dönüştür
2. frekans tablosunu kazanmak için özet () kullanın
3. dönüş modu, frekansı en büyük olan dizin
4. 1'den fazla mod olsa bile faktörü sayısal değere dönüştürün, bu işlev iyi çalışır!

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

Hesaplama Modu çoğunlukla faktör değişkeni olması durumunda

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

HouseVotes84, 'mlbench' paketinde bulunan veri kümesidir.

maksimum etiket değeri verecektir. fonksiyon yazmadan dahili fonksiyonların kendisiyle kullanımı daha kolaydır.

Bana öyle geliyor ki bir koleksiyonun bir modu varsa, o zaman unsurları doğal sayılarla birebir eşlenebilir. Bu nedenle, modu bulma sorunu, böyle bir eşleme üretmeye, eşlenen değerlerin modunu bulmaya ve ardından koleksiyondaki bazı öğelere geri eşlemeye indirgenir. ( NAHaritalama aşamasında işlem yapılır).

histogramBenzer bir prensipte çalışan bir fonksiyonum var. (Burada sunulan kodda kullanılan özel işlevler ve işleçler Shapiro ve / veya neatOveRse içinde tanımlanmalıdır . Burada çoğaltılan Shapiro ve neatOveRse bölümleri izinle bu kadar çoğaltılmıştır; çoğaltılan parçacıklar bu sitenin koşulları altında kullanılabilir. ) R, yalancı kod için histogramIS

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

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

(Özel ikili operatörler borulama , körelme ve kompozisyonu başarırlar ) Ben de maxlocbenzer bir fonksiyona sahibim which.max, fakat bir vektörün tüm mutlak maksimumlarını döndürür . R, yalancı kod için 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

Sonra

imode <- histogram %O% maxloc

ve

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

uygun map-ping ve unmap-ping işlevlerinin tanımlanması koşuluyla, herhangi bir koleksiyonun modunu hesaplar .