W R, mean()a median()to standardowe funkcje które robią to, czego można oczekiwać. mode()informuje o trybie pamięci wewnętrznej obiektu, a nie o wartości, która występuje najczęściej w jego argumencie. Ale czy istnieje standardowa funkcja biblioteki, która implementuje tryb statystyczny dla wektora (lub listy)?

Jeszcze jedno rozwiązanie, które działa zarówno w przypadku danych liczbowych, jak i danych / współczynników:

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

Na mojej przeklętej małej maszynie, która może wygenerować i znaleźć tryb wektora liczb całkowitych 10M w około pół sekundy.

Jeśli Twój zestaw danych może mieć wiele trybów, powyższe rozwiązanie przyjmuje to samo podejście which.maxi zwraca pierwszą wartość z zestawu trybów. Aby zwrócić wszystkie tryby, użyj tego wariantu (od @digEmAll w komentarzach):

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

Istnieje pakiet, modeestktóry zapewnia estymatory trybu jednowymiarowych danych unimodalnych (a czasem multimodalnych) oraz wartości trybów zwykłych rozkładów prawdopodobieństwa.

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

Aby uzyskać więcej informacji, zobacz tę stronę

znalazłem to na liście mailingowej r, mam nadzieję, że jest to pomocne. Tak też myślałem. Będziesz chciał zebrać () dane, posortować, a następnie wybrać imię. To jest hackerskie, ale powinno działać.

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

Uznałem, że powyższy post Kena Williamsa jest świetny, dodałem kilka wierszy, aby uwzględnić wartości NA i uczyniłem go łatwym.

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

Szybkim i brudnym sposobem oszacowania trybu wektora liczb, który Twoim zdaniem pochodzi z ciągłego rozkładu jednowymiarowego (np. Rozkład normalny), jest zdefiniowanie i użycie następującej funkcji:

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

Następnie, aby uzyskać oszacowanie trybu:

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

Następująca funkcja występuje w trzech postaciach:

method = "mode" [default]: oblicza tryb dla wektora unimodalnego, w przeciwnym razie zwraca
metodę NA = "nmodes": oblicza liczbę trybów w wektorze
method = " styles ": wyświetla wszystkie tryby dla unimodalnego lub polimodalnego wektor

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

Oto inne rozwiązanie:

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

Nie mogę jeszcze głosować, ale szukałem odpowiedzi Rasmusa Bååtha. Jednak zmodyfikowałbym to trochę, pozwalając ograniczyć rozkład, na przykład dla wartości tylko od 0 do 1.

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

Wiemy, że możesz nie chcieć ograniczać całej dystrybucji, a następnie ustaw od = - „DUŻY NUMER” do = „DUŻY NUMER”

Mała modyfikacja odpowiedzi Kena Williamsa, dodająca opcjonalne parametry na.rmi return_multiple.

W przeciwieństwie do odpowiedzi, na których się opiera names(), odpowiedź ta zachowuje typ danych xw zwracanych wartościach.

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

Aby pokazać, że działa z opcjonalnymi parametrami i zachowuje typ danych:

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"

Dzięki @Frank za uproszczenie.

Napisałem następujący kod, aby wygenerować tryb.

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

Spróbujmy:

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

Na podstawie funkcji @ Chrisa do obliczenia trybu lub powiązanych wskaźników, jednak z wykorzystaniem metody Kena Williamsa do obliczenia częstotliwości. Ten zapewnia poprawkę w przypadku braku trybów (wszystkie elementy są jednakowo częste), a niektóre bardziej czytelne methodnazwy.

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

Ponieważ używa metody Kena do obliczania częstotliwości, wydajność jest również zoptymalizowana, używając postu AkselA porównałem niektóre z poprzednich odpowiedzi, aby pokazać, jak moja funkcja jest zbliżona do wydajności Kena, przy czym warunki dla różnych opcji wyjścia powodują jedynie niewielki narzut:

Ten hack powinien działać dobrze. Podaje wartość, a także liczbę trybów:

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

R ma tak wiele dodatków, że niektóre z nich mogą zapewnić tryb [statystyczny] listy numerycznej / serii / wektora.

Jednak standardowa biblioteka samego R nie wydaje się mieć takiej wbudowanej metody! Jednym ze sposobów obejścia tego jest użycie takiej konstrukcji jak poniżej (i włączenie tej funkcji, jeśli często ją używasz ...):

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

W przypadku większej listy próbek należy rozważyć użycie zmiennej tymczasowej dla wartości max (tabSmpl) (nie wiem, czy R automatycznie to zoptymalizuje)

Odniesienie: patrz „Co z medianą i trybem?” w tej lekcji KickStarting R
To wydaje się potwierdzać, że (przynajmniej w momencie pisania tej lekcji) nie ma funkcji trybu w R (no cóż ... tryb (), jak się przekonałeś, służy do potwierdzenia typu zmiennych ).

To działa całkiem dobrze

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

Oto funkcja znajdowania trybu:

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

Poniżej znajduje się kod, którego można użyć do znalezienia trybu zmiennej wektorowej w R.

a <- table([vector])

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

Istnieje wiele rozwiązań dla tego. Sprawdziłem pierwszy, a potem napisałem własny. Opublikowanie go tutaj, jeśli pomoże komukolwiek:

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

Przetestujmy to na kilku przykładach. Biorę iriszestaw danych. Pozwala przetestować dane numeryczne

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

który możesz zweryfikować, jest poprawny.

Teraz jedyne pole nienumeryczne w zestawie danych tęczówki (Gatunek) nie ma trybu. Przetestujmy na naszym własnym przykładzie

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

EDYTOWAĆ

Jak wspomniano w komentarzach, użytkownik może chcieć zachować typ danych wejściowych. W takim przypadku funkcję trybu można zmienić na:

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

Ostatni wiersz funkcji po prostu wymusza wartość trybu końcowego na typ oryginalnego wejścia.

Użyłbym funkcji gęstości (), aby zidentyfikować wygładzone maksimum (ewentualnie ciągłego) rozkładu:

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

gdzie x to zbiór danych. Zwróć uwagę na regulowany parametr funkcji gęstości, który reguluje wygładzanie.

Chociaż lubię prostą funkcję Kena Williamsa, chciałbym odzyskać wiele trybów, jeśli istnieją. Mając to na uwadze, korzystam z następującej funkcji, która zwraca listę trybów, jeśli jest ich wiele lub jeden.

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

Przeglądałem wszystkie te opcje i zacząłem się zastanawiać nad ich względnymi funkcjami i wydajnością, więc zrobiłem kilka testów. W przypadku, gdy ktoś jest ciekawy tego samego, dzielę się tutaj swoimi wynikami.

Nie chcąc zawracać sobie głowy wszystkimi opublikowanymi tutaj funkcjami, postanowiłem skupić się na próbce opartej na kilku kryteriach: funkcja powinna działać zarówno na wektorach znakowych, czynnikowych, logicznych i liczbowych, powinna odpowiednio radzić sobie z NA i innymi problematycznymi wartościami, a dane wyjściowe powinny być „rozsądne”, tj. nie mogą zawierać znaków numerycznych ani innych podobnych głupstw.

Dodałem także własną funkcję, która opiera się na tej samej rleidei co chrispy, z wyjątkiem tego, że jest przystosowana do bardziej ogólnego zastosowania:

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

Skończyło się na tym, że uruchomiłem pięć funkcji na dwóch zestawach danych testowych microbenchmark. Nazwy funkcji odnoszą się do ich autorów:

Funkcja Chrisa została ustawiona na method="modes"ina.rm=TRUE domyślnie, aby uczynić ją bardziej porównywalną, ale poza tym funkcje były używane w sposób przedstawiony tutaj przez ich autorów.

Jeśli chodzi o samą szybkość, wersja Kensa wygrywa z łatwością, ale jest to również jedyny z nich, który zgłasza tylko jeden tryb, bez względu na to, ile tak naprawdę jest. Jak to często bywa, istnieje kompromis między szybkością a wszechstronnością. W method="mode"wersji Chris zwróci wartość, jeśli jest jeden tryb, w przeciwnym razie NA. Myślę, że to miły akcent. Myślę też, że to ciekawe, jak na niektóre funkcje wpływa zwiększona liczba unikalnych wartości, podczas gdy inne nie są tak bardzo. Nie studiowałem szczegółowo kodu, aby dowiedzieć się, dlaczego tak jest, oprócz wyeliminowania logicznej / numerycznej przyczyny.

Tryb nie może być przydatny w każdej sytuacji. Dlatego funkcja powinna rozwiązać tę sytuację. Wypróbuj następującą funkcję.

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

Wynik,

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

Opiera się to na odpowiedzi jprockbelly, dodając przyspieszenie dla bardzo krótkich wektorów. Jest to przydatne, gdy stosuje się tryb do data.frame lub danych z dużą liczbą małych grup:

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

Inną prostą opcją, która podaje wszystkie wartości uporządkowane według częstotliwości, jest użycie rle:

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

Inne możliwe rozwiązanie:

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

Stosowanie:

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

Wynik:

   user  system elapsed 
   0.32    0.00    0.31 

Uważam, że twoje obserwacje są klasami z liczb rzeczywistych i oczekujesz, że tryb będzie wynosił 2,5, gdy twoje obserwacje to 2, 2, 3 i 3, to możesz oszacować tryb, w mode = l1 + i * (f1-f0) / (2f1 - f0 - f2)którym l1 .. dolna granica najczęstszej klasy, f1 . . częstotliwość najczęstszych klas, f0 .. częstotliwość klas przed najczęstszymi klasami, f2 .. częstotliwość klas po najczęstszych klasach i i. przedział klas podany np. w 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

Jeśli chcesz mieć najczęstszy poziom i masz więcej niż jeden najczęstszy poziom, możesz uzyskać je wszystkie, np .:

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

Dodanie możliwego podejścia do tabeli danych

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

Oto kilka sposobów na zrobienie tego w czasie wykonywania 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))

Można wypróbować następującą funkcję:

1. przekształcić wartości liczbowe na czynnik
2. użyj podsumowania (), aby uzyskać tabelę częstotliwości
3. tryb powrotu indeks, którego częstotliwość jest największa
4. przekształć współczynnik z powrotem na numeryczny, nawet jeśli jest więcej niż 1 tryb, ta funkcja działa dobrze!

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

Tryb obliczania dotyczy głównie zmiennej czynnikowej, którą możemy zastosować

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

HouseVotes84 to zestaw danych dostępny w pakiecie „mlbench”.

da maksymalną wartość etykiety. jest łatwiejszy w użyciu dzięki wbudowanym funkcjom bez funkcji zapisu.

Wydaje mi się, że jeśli kolekcja ma tryb, to jego elementy można mapować jeden na jeden z liczbami naturalnymi. Problem znalezienia trybu sprowadza się więc do utworzenia takiego mapowania, znalezienia trybu mapowanych wartości, a następnie mapowania z powrotem do niektórych elementów w kolekcji. (Do czynienia zNA występuje w fazie mapowania).

Mam histogramfunkcję, która działa na podobnej zasadzie. (Funkcje specjalne i operatory użyte w kodzie prezentowanym w niniejszym dokumencie powinny być zdefiniowane w Shapiro i / lub neatOveRse . Części Shapiro i neatOveRse tutaj zduplikowane są tak powielone za zgodą; zduplikowane fragmenty mogą być używane zgodnie z warunkami tej witryny. ) Pseudokod R dla histogramis

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

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

(Szczególne Operatory wykonania rur , currying i skład ) również mają maxlocfunkcję podobną do which.max, ale zwraca wszystkie absolutnym maxima wektora. Pseudokod R dla 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

Następnie

imode <- histogram %O% maxloc

i

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

obliczy tryb dowolnej kolekcji, pod warunkiem zdefiniowania odpowiednich funkcji map-ping i unmap-ping.