Di R, mean()dan median()merupakan fungsi standar yang melakukan apa yang Anda harapkan. mode()memberi tahu Anda mode penyimpanan internal objek, bukan nilai yang paling banyak muncul dalam argumennya. Tetapi apakah ada fungsi perpustakaan standar yang mengimplementasikan mode statistik untuk vektor (atau daftar)?

Satu lagi solusi, yang berfungsi untuk data numerik & karakter / faktor:

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

Pada mesin mungil mungil saya, yang dapat menghasilkan & menemukan mode vektor 10M-integer dalam waktu sekitar setengah detik.

Jika kumpulan data Anda memiliki beberapa mode, solusi di atas mengambil pendekatan yang sama dengan which.max, dan mengembalikan nilai yang muncul pertama dari set mode. Untuk mengembalikan semua mode, gunakan varian ini (dari @digEmAll di komentar):

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

Ada paket modeestyang menyediakan penduga mode univariat data unimodal (dan kadang-kadang multimodal) dan nilai mode distribusi probabilitas biasa.

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

Untuk informasi lebih lanjut lihat halaman ini

menemukan ini di r mailing list, semoga bermanfaat. Itu juga yang saya pikirkan. Anda ingin membuat tabel () data, mengurutkan dan kemudian memilih nama depan. Ini retas tetapi harus bekerja.

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

Saya menemukan posting Ken Williams di atas sangat bagus, saya menambahkan beberapa baris untuk menjelaskan nilai-nilai NA dan membuatnya berfungsi untuk memudahkan.

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

Cara cepat dan kotor dalam memperkirakan mode vektor angka yang Anda yakini berasal dari distribusi univariat berkelanjutan (mis. Distribusi normal) adalah mendefinisikan dan menggunakan fungsi berikut:

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

Kemudian untuk mendapatkan estimasi mode:

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

Fungsi berikut hadir dalam tiga bentuk:

method = "mode" [default]: menghitung mode untuk vektor unimodal, kalau tidak mengembalikan
metode NA = "nmodes": menghitung jumlah mode dalam
metode vektor = "mode": daftar semua mode untuk unimodal atau polymodal vektor

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

Di sini, solusi lain:

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

Saya belum bisa memilih tetapi jawaban Rasmus Bååth adalah yang saya cari. Namun, saya akan memodifikasinya sedikit memungkinkan untuk membatasi distribusi misalnya hanya nilai antara 0 dan 1.

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

Kami menyadari bahwa Anda mungkin tidak ingin membatasi sama sekali pada distribusi Anda, lalu mengatur dari = - "NOMOR BESAR", hingga = "NOMOR BESAR"

Modifikasi kecil untuk jawaban Ken Williams, menambahkan params opsional na.rmdan return_multiple.

Berbeda dengan jawaban yang mengandalkan names(), jawaban ini mempertahankan tipe data xdalam nilai yang dikembalikan.

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

Untuk menunjukkannya berfungsi dengan params opsional dan memelihara tipe data:

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"

Berkat @ Frank untuk penyederhanaan.

Saya telah menulis kode berikut untuk menghasilkan mode.

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

Mari kita coba:

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

Berdasarkan fungsi @ Chris untuk menghitung mode atau metrik terkait, namun menggunakan metode Ken Williams untuk menghitung frekuensi. Yang satu ini menyediakan perbaikan untuk kasus tidak ada mode sama sekali (semua elemen sama-sama sering), dan beberapa methodnama yang lebih mudah dibaca .

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

Karena menggunakan metode Ken untuk menghitung frekuensi, kinerjanya juga dioptimalkan, menggunakan postingan AkselA, saya membandingkan beberapa jawaban sebelumnya untuk menunjukkan bagaimana fungsi saya dekat dengan kinerja Ken, dengan persyaratan untuk berbagai opsi ouput yang hanya menyebabkan sedikit overhead:

Peretasan ini seharusnya bekerja dengan baik. Memberi Anda nilai serta hitungan mode:

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

R memiliki begitu banyak paket tambahan yang beberapa di antaranya mungkin menyediakan mode [statistik] dari daftar numerik / seri / vektor.

Namun pustaka standar R itu sendiri tampaknya tidak memiliki metode bawaan! Salah satu cara untuk mengatasi ini adalah dengan menggunakan beberapa konstruksi seperti berikut (dan untuk mengubahnya menjadi fungsi jika Anda sering menggunakan ...):

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

Untuk daftar sampel yang lebih besar, orang harus mempertimbangkan menggunakan variabel sementara untuk nilai maks (tabSmpl) (saya tidak tahu bahwa R akan secara otomatis mengoptimalkan ini)

Referensi: lihat "Bagaimana dengan median dan mode?" dalam pelajaran KickStarting R
ini Tampaknya mengkonfirmasi bahwa (setidaknya pada saat penulisan pelajaran ini) tidak ada fungsi mode dalam R (well ... mode () seperti yang Anda temukan digunakan untuk menyatakan jenis variabel ).

Ini bekerja dengan sangat baik

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

Berikut adalah fungsi untuk menemukan mode:

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

Di bawah ini adalah kode yang dapat digunakan untuk menemukan mode variabel vektor dalam R.

a <- table([vector])

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

Ada beberapa solusi yang disediakan untuk yang satu ini. Saya memeriksa yang pertama dan setelah itu menulis sendiri. Posting di sini jika itu membantu siapa pun:

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

Mari kita mengujinya dengan beberapa contoh. Saya mengambil iriskumpulan data. Mari kita uji dengan data numerik

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

yang dapat Anda verifikasi benar.

Sekarang satu-satunya bidang non numerik dalam set data iris (Spesies) tidak memiliki mode. Mari kita coba dengan contoh kita sendiri

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

EDIT

Seperti disebutkan dalam komentar, pengguna mungkin ingin mempertahankan tipe input. Dalam hal ini fungsi mode dapat dimodifikasi untuk:

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

Baris terakhir fungsi hanya memaksa nilai mode akhir ke jenis input asli.

Saya akan menggunakan fungsi density () untuk mengidentifikasi distribusi maksimum (mungkin berkesinambungan) yang dihaluskan:

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

di mana x adalah pengumpulan data. Perhatikan paremeter yang menyesuaikan fungsi kepadatan yang mengatur smoothing.

Sementara saya menyukai fungsi sederhana Ken Williams, saya ingin mengambil beberapa mode jika ada. Dengan mengingat hal itu, saya menggunakan fungsi berikut yang mengembalikan daftar mode jika banyak atau tunggal.

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

Saya melihat-lihat semua opsi ini dan mulai bertanya-tanya tentang fitur dan penampilan relatif mereka, jadi saya melakukan beberapa tes. Jika ada orang yang ingin tahu tentang hal yang sama, saya membagikan hasil saya di sini.

Tidak ingin repot dengan semua fungsi yang diposting di sini, saya memilih untuk fokus pada sampel berdasarkan beberapa kriteria: fungsi tersebut harus bekerja pada kedua karakter, vektor faktor, logis dan numerik, harus berurusan dengan NAS dan nilai bermasalah lainnya dengan tepat, dan output harus 'masuk akal', yaitu tidak ada angka sebagai karakter atau kekonyolan lainnya.

Saya juga menambahkan fungsi saya sendiri, yang didasarkan pada rleide yang sama dengan chrispy, kecuali diadaptasi untuk penggunaan yang lebih umum:

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

Saya akhirnya menjalankan lima fungsi, pada dua set data uji, sampai microbenchmark. Nama fungsi merujuk ke penulis masing-masing:

Fungsi Chris diatur ke method="modes"danna.rm=TRUE secara default untuk membuatnya lebih sebanding, tetapi selain itu fungsi digunakan seperti yang disajikan di sini oleh penulisnya.

Dalam hal kecepatan saja, versi Kens menang dengan mudah, tetapi ini juga satu-satunya yang hanya akan melaporkan satu mode, tidak peduli berapa banyak sebenarnya. Seperti yang sering terjadi, ada pertukaran antara kecepatan dan keserbagunaan. Dalam method="mode", versi Chris akan mengembalikan nilai jika ada satu mode, selain itu NA. Saya pikir itu sentuhan yang bagus. Saya juga berpikir itu menarik bagaimana beberapa fungsi dipengaruhi oleh peningkatan jumlah nilai unik, sementara yang lain tidak sebanyak. Saya belum mempelajari kode secara rinci untuk mencari tahu mengapa itu, selain menghilangkan logis / numerik sebagai penyebabnya.

Mode tidak dapat berguna dalam setiap situasi. Jadi fungsinya harus mengatasi situasi ini. Coba fungsi berikut.

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

Keluaran,

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

Ini dibangun berdasarkan jawaban jprockbelly, dengan menambahkan kecepatan untuk vektor yang sangat singkat. Ini berguna ketika menerapkan mode ke data.frame atau datatable dengan banyak grup kecil:

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

Opsi sederhana lain yang memberikan semua nilai yang dipesan berdasarkan frekuensi adalah menggunakan rle:

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

Solusi lain yang mungkin:

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

Pemakaian:

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

Keluaran:

   user  system elapsed 
   0.32    0.00    0.31 

Saya perhatikan pengamatan Anda adalah kelas dari bilangan real dan Anda berharap bahwa mode menjadi 2,5 ketika pengamatan Anda adalah 2, 2, 3, dan 3 maka Anda dapat memperkirakan mode dengan di mode = l1 + i * (f1-f0) / (2f1 - f0 - f2)mana l1 .. batas lebih rendah dari kelas paling sering, f1 . Frekuensi kelas paling sering, f0 .. frekuensi kelas sebelum kelas paling sering, f2 .. frekuensi kelas setelah kelas paling sering dan saya .. Interval kelas seperti yang diberikan misalnya dalam 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

Jika Anda menginginkan level yang paling sering dan Anda memiliki lebih dari satu level yang paling sering, Anda bisa mendapatkan semuanya misalnya dengan:

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

Menambahkan kemungkinan pendekatan 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)}]

Berikut adalah beberapa cara yang dapat Anda lakukan dalam menjalankan waktu 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))

Bisa mencoba fungsi berikut:

1. mengubah nilai numerik menjadi faktor
2. gunakan ringkasan () untuk mendapatkan tabel frekuensi
3. mode pengembalian indeks yang frekuensinya terbesar
4. mengubah faktor kembali ke numerik walaupun ada lebih dari 1 mode, fungsi ini berfungsi dengan baik!

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

Mode Menghitung sebagian besar dalam hal variabel faktor maka kita dapat menggunakan

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

HouseVotes84 adalah dataset yang tersedia dalam paket 'mlbench'.

itu akan memberikan nilai label max. lebih mudah digunakan dengan fungsi inbuilt itu sendiri tanpa fungsi penulisan.

Menurut saya, jika koleksi memiliki mode, maka elemen-elemennya dapat dipetakan satu-ke-satu dengan bilangan asli. Jadi, masalah menemukan mode berkurang menjadi menghasilkan pemetaan seperti itu, menemukan mode nilai yang dipetakan, lalu memetakan kembali ke beberapa item dalam koleksi. (Berurusan dengan NAterjadi pada fase pemetaan).

Saya memiliki histogramfungsi yang beroperasi pada prinsipal yang serupa. (Fungsi dan operator khusus yang digunakan dalam kode yang disajikan di sini harus didefinisikan dalam Shapiro dan / atau neatOveRse . Bagian-bagian dari Shapiro dan neatOveRse yang diduplikasi di sini sangat digandakan dengan izin; snipet yang digandakan dapat digunakan berdasarkan ketentuan situs ini. ) R pseudocode untuk histogramis

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

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

(Operator biner khusus menyelesaikan perpipaan , currying , dan komposisi ) Saya juga punyamaxloc fungsi, yang mirip dengan which.max, tetapi mengembalikan semua maxima absolut vektor. R pseudocode untuk 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

Kemudian

imode <- histogram %O% maxloc

dan

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

akan menghitung mode koleksi apa pun, asalkan sesuai mapdanunmap fungsi- -ping yang sesuai didefinisikan.