Istnieje Pakiet modeest, który dostarcza estymatorów trybu jednostkowych danych unimodalnych (a czasem multimodalnych) i 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 ta strona

Znalazłem to na liście dyskusyjnej r, mam nadzieję, że to pomoże. I tak też o tym myślałem. Będziesz chciał tabelę () danych, posortować, a następnie wybrać imię. To hakerskie, ale powinno zadziałać.

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

Uznałem post Kena Williamsa za świetny, dodałem kilka linii, aby uwzględnić wartości NA i zrobiłem z niego funkcję dla ułatwienia.

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

Szybki i brudny sposób szacowania trybu wektora liczb, który według Ciebie pochodzi z ciągłego rozkładu jednowymiarowego (np. rozkładu normalnego), definiuje i używa 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 formach:

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

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

Tutaj 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 odpowiedź Rasmusa Bååtha jest tym, czego szukałem. Chciałbym jednak nieco zmodyfikować, pozwalając na kontrastowanie rozkładu np. wartości fro tylko pomiędzy 0 a 1.

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

Zdajemy sobie sprawę, że możesz nie chcieć ograniczać w ogóle swojej dystrybucji, następnie Ustaw od= - "duża liczba", do="duża liczba"

Napisałem następujący kod w celu wygenerowania trybu.

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)

Mała modyfikacja odpowiedzi Kena Williamsa, dodanie opcjonalnych param na.rm i return_multiple.

W przeciwieństwie do odpowiedzi opartych na names(), Ta odpowiedź utrzymuje typ danych x w zwracanej wartości.

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 params i utrzymuje 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"

Podziękowania dla @ Frank za uproszczenie.

Ten hack powinien działać dobrze. Podaje wartość oraz liczbę mode:

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

Na podstawie funkcji @ Chris do obliczania trybu lub powiązanych metryk, jednak przy użyciu metody Kena Williamsa do obliczania częstotliwości. Ten zapewnia poprawkę w przypadku braku trybów w ogóle (wszystkie elementy są jednakowo częste), oraz kilka bardziej czytelnych nazw 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'")
}

Ponieważ wykorzystuje metodę Kena do obliczania częstotliwości, wydajność jest również zoptymalizowana, korzystając z postu Akseli, porównałem niektóre z poprzednich odpowiedzi, aby pokazać, jak moja funkcja jest bliska wydajności Kena, z warunków dla różnych opcji ouput powodujących tylko niewielkie koszty:

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

Jednak biblioteka standardowa R sama w sobie nie wydaje się mieć takiej wbudowanej metody! Jednym ze sposobów obejścia tego problemu jest użycie jakiegoś konstruktu podobnego do poniższego (i przekształcenie go w funkcję, jeśli używasz go często...):

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

Dla większej listy przykładowej należy rozważyć użycie zmiennej tymczasowej dla wartości max (tabSmpl) (Nie wiem, czy R automatycznie Optymalizuj to)

Odniesienie: Patrz " a co z medianą i modem?"w tym KickStarting r lesson
To wydaje się potwierdzać, że (przynajmniej w momencie pisania tej lekcji) nie ma funkcji mode W R (dobrze... mode () jak się dowiedziałeś służy do sprawdzania typu zmiennych).

Oto funkcja do znalezienia 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)
}

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

Chociaż lubię prostą funkcję Kena Williamsa, chciałbym pobrać wiele trybów, jeśli istnieją. Mając to na uwadze, używam poniższej funkcji, która zwraca listę trybów, jeśli jest wiele lub pojedynczy.

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 zastanawiać się nad ich względnymi funkcjami i wydajnością, więc zrobiłem kilka testów. W przypadku, gdyby ktoś jeszcze był ciekawy tego samego, dzielę się moimi wynikami tutaj.

Nie chcąc przejmować się wszystkimi funkcjami tutaj zamieszczonymi, postanowiłem skupić się na przykładzie opartym na kilku kryteriach: funkcja powinna pracować zarówno na wektorach znakowych, faktorowych, logicznych i numerycznych, powinna odpowiednio radzić sobie z NAs i innymi problematycznymi wartościami, a wyjście powinno być "sensowne", tzn. brak cyfr jako znaków lub innych takich głupstw.

Dodałem również własną funkcję, która jest oparta na tym samym pomyśle rle Co chrispy ' s, z tym, że dostosowana 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łem uruchamiając pięć funkcji, na dwóch zestawach danych testowych, przez microbenchmark. Nazwy funkcji odnoszą się do ich autorów:

Funkcja Chrisa została domyślnie ustawiona na method="modes" i na.rm=TRUE, aby była bardziej porównywalna, ale inna niż że funkcje te zostały użyte w sposób przedstawiony tutaj przez ich autorów.

Tylko w kwestii prędkości Wersja Kens wygrywa zręcznie, ale jest również jedyną z nich, która zgłosi tylko jeden tryb, bez względu na to, ile ich naprawdę jest. Jak to często bywa, istnieje kompromis między szybkością a wszechstronnością. W method="mode", Wersja Chrisa zwróci wartość iff jest jeden tryb, w przeciwnym razie NA. Myślę, że to miły akcent. Myślę również, że to ciekawe, jak niektóre funkcje są wpływane przez zwiększone liczba unikalnych wartości, podczas gdy inne nie są prawie tak wiele. Nie przestudiowałem kodu szczegółowo, aby dowiedzieć się, dlaczego tak jest, oprócz wyeliminowania logicznego / numerycznego jako przyczyny.

Istnieje wiele rozwiązań dla tego. Sprawdziłam pierwszą, a potem napisałam własną. Wrzuć tutaj, jeśli komuś to pomoże:

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

Lets test it with a few example. Biorę iris zestaw danych. Lets test with numeric data

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

Które możesz zweryfikować jest poprawne.

Teraz jedyne nieliczbowe pole w zbiorze danych iris (Species) nie ma trybu. Przetestujmy na naszym własnym przykładzie

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

EDIT

Jak wspomniano w komentarze, użytkownik może chcieć zachować Typ wprowadzania. W takim przypadku funkcja mode może zostać zmieniona 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 ostateczną wartość trybu do typu oryginalnego wejścia.

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)

Użyłbym funkcji density() do określenia wygładzonego maksimum (być może ciągłego) rozkładu:

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

Gdzie x jest zbiorem danych. Zwróć uwagę na dopasuj parmetr funkcji gęstości, która reguluje wygładzanie.

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

Użycie:

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

Wyjście:

   user  system elapsed 
   0.32    0.00    0.31 

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

a <- table([vector])

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

Tryb nie może być przydatny w każdej sytuacji. Więc funkcja powinna zająć się 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)
}

Wyjście,

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

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

1. przekształć wartości liczbowe w współczynnik
2. Użyj summary (), aby uzyskać tabelę częstotliwości
3. return mode indeks, którego częstotliwość jest największa
4. transform factor back to numeric nawet istnieje 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 jest najczęściej w przypadku zmiennej czynnika wtedy możemy użyć

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

HouseVotes84 to zbiór danych dostępny w pakiecie 'mlbench'.

Da maksymalną wartość etykiety. jest łatwiejszy w użyciu przez wbudowane funkcje bez funkcji zapisu.

Przepraszam, mogę przyjąć to za proste, ale czy to nie wystarczy? (W 1.3 SEK dla wartości 1E6 na mojej maszynie):

t0 <- Sys.time()
summary(as.factor(round(rnorm(1e6), 2)))[1]
Sys.time()-t0

Musisz tylko zastąpić "round (rnorm(1E6),2)" twoim wektorem.

Możesz również obliczyć liczbę wystąpień w twoim zestawie i znaleźć maksymalną liczbę. np.

> temp <- table(as.vector(x))
> names (temp)[temp==max(temp)]
[1] "1"
> as.data.frame(table(x))
r5050 Freq
1     0   13
2     1   15
3     2    6
> 

Łatwym sposobem obliczenia trybu wektora " v " zawierającego wartości dyskretne jest:

names(sort(table(v)))[length(sort(table(v)))]