是否有用于查找模式的内置功能?

时间:2010-03-30 17:55:08

标签: r statistics r-faq

在R中,mean()median()是标准函数,可以满足您的期望。 mode()告诉您对象的内部存储模式,而不是其参数中出现最多的值。但是有一个标准的库函数来实现向量(或列表)的统计模式吗?

36 个答案:

答案 0 :(得分:359)

另一个解决方案,适用于数字和数字字符/因子数据:

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

在我的小机器上,可以生成&amp;在大约半秒内找到10M整数向量的模式。

如果您的数据集可能有多种模式,则上述解决方案采用与which.max相同的方法,并返回该组模式的首先出现的值。要返回所有模式,请使用此变体(来自评论中的@digEmAll):

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

答案 1 :(得分:61)

有一个包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")

有关详细信息,请参阅this page

答案 2 :(得分:53)

在r邮件列表中找到了这个,希望它有用。这也是我的想法。你需要table()数据,排序然后选择第一个名字。这是hackish但应该工作。

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

答案 3 :(得分:42)

我发现肯·威廉姆斯在上面的帖子很棒,我添加了几行来解释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)))])
}

答案 4 :(得分:28)

快速而肮脏的方法来估计您认为来自连续单变量分布(例如正态分布)的数字向量的模式是定义和使用以下函数:

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

答案 5 :(得分:13)

以下功能有三种形式:

method =“mode”[default]:计算单峰向量的模式,否则返回NA
method =“nmodes”:计算向量中的模式数量
method =“modes”:列出单峰或多峰矢量的所有模式

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

答案 6 :(得分:10)

这里,另一种解决方案:

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

答案 7 :(得分:9)

我不能投票,但RasmusBååth的回答正是我所寻求的。 但是,我会稍微修改它,允许限制分布,例如仅在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)]
}

我们知道您可能不想限制所有发行版,然后从= - “BIG NUMBER”设置为=“BIG NUMBER”

答案 8 :(得分:8)

Ken Williams回答的一个小修改,添加了可选参数na.rmreturn_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的简化。

答案 9 :(得分:7)

我已编写以下代码以生成模式。

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)

答案 10 :(得分:6)

这个hack应该可以正常工作。给你价值以及模式的数量:

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

答案 11 :(得分:5)

基于@Chris的函数计算模式或相关指标,但使用Ken Williams的方法计算频率。这个提供了对没有模式(所有元素同等频繁)的情况的修复,以及一些更易读的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'")
}

由于它使用Ken的方法来计算频率,因此性能也得到了优化,使用AkselA的帖子我对一些先前的答案进行了基准测试,以显示我的功能是如何接近Ken的。性能,使用各种输出选项的条件只会产生轻微的开销: Comparison of Mode functions

答案 12 :(得分:3)

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 lesson中 这似乎证实了(至少在撰写本课时)R中没有模式函数(well ... mode(),因为你发现它用于断言变量的类型)。

答案 13 :(得分:3)

这是一个找到模式的函数:

{Question:$(".question").serialize()}

答案 14 :(得分:3)

这很好用

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

答案 15 :(得分:2)

为此提供了多种解决方案。我检查了第一个,然后写了我自己的。如果它可以帮助任何人,请在此处发布:

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

修改

如评论中所述,用户可能希望保留输入类型。在这种情况下,模式功能可以修改为:

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

该函数的最后一行只是将最终模式值强制转换为原始输入的类型。

答案 16 :(得分:2)

模式并非在每种情况下都有用。因此,该功能应解决这种情况。尝试以下功能。

(function() {
  var url=window.location.href;
  stringUrl=String(url);
  stringUrl=stringUrl.replace(/^https:\/\/www.xxxxxx.org.uk\/, "https://edit.xxxxxx.org.uk/EPiServer/CMS/Home#context=epi.cms.contentdata:///");
  document.location=stringUrl;
})();

输出

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

答案 17 :(得分:2)

虽然我喜欢Ken Williams的简单功能,但我想检索多种模式(如果它们存在)。考虑到这一点,我使用以下函数返回模式列表,如果是多个或单个。

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

答案 18 :(得分:2)

我正在浏览所有这些选项并开始怀疑他们的相关特征和表现,所以我做了一些测试。如果其他人对此感到好奇,我会在这里分享我的结果。

我不想打扰这里发布的所有函数,我选择基于一些标准关注一个样本:该函数应该对字符,因子,逻辑和数字向量起作用,它应该处理NA和其他问题适当的价值观,输出应该是“明智的”,即没有数字作为特征或其他类似的愚蠢。

我还添加了一个我自己的功能,它基于与chrispy相同的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在两组测试数据上运行了五个函数。函数名称指其各自的作者:

enter image description here

Chris的功能默认设置为method="modes"na.rm=TRUE,以使其更具可比性,但除此之外,其作者使用的功能也是如此。

就速度问题而言,Kens版本可以轻松获胜,但它也是唯一一个只报告一种模式的模式,无论有多少模式。通常情况下,速度和多功能性之间存在权衡。在method="mode"中,如果有一种模式,Chris'版本将返回一个值,否则为NA。我觉得这很不错。 我也认为有些函数会受到增加的唯一值的影响,而其他函数的差别不大。我没有详细研究代码,以找出原因,除了消除逻辑/数字作为原因。

答案 19 :(得分:2)

下面是可用于在R中找到矢量变量模式的代码。

a <- table([vector])

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

答案 20 :(得分:1)

这是基于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)))]
}

答案 21 :(得分:1)

我假设您的观察值为Real numbers,并且您期望当观察值为2、2、3和3时,模式为2.5那么您可以使用mode = l1 + i * (f1-f0) / (2f1 - f0 - f2)来估计模式,其中 l1 ..最常见类别的下限 f1 ..最常见类别的频率 f0 ..最频繁上课的班次频率, f2 ..最频繁上课的班次频率和 i ..班级间隔,例如:在123中:

#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

如果您想要most frequent level,并且您拥有一个以上最频繁的级别,则可以获取所有这些信息,例如与:

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

答案 22 :(得分:1)

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

答案 23 :(得分:1)

另一种可能的解决方案:

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 

答案 24 :(得分:1)

我会使用density()函数来识别(可能是连续的)分布的平滑最大值:

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

其中x是数据集合。注意调节平滑的密度函数的调整参数。

答案 25 :(得分:1)

另一个提供按频率排序的所有值的简单选项是使用rle

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

答案 26 :(得分:0)

计算模式主要是因子变量然后我们可以使用

var FirstClick;
var ClickOne;
var ClickTwo;
$('.ColorPreview').on('click',function() {

var ColorId = $(this).attr('id');
    ColorId = Number(ColorId.split('_')[1]);

    if (!FirstClick) {
        //reset function
        for (var i = 0; i < 16; i++) {
        $('#Color_' + i).removeClass('SelectColor'); }
        var ClickTwo;

        ClickOne = ColorId; 
        FirstClick = true; 
        }

    else {
        ClickTwo = ColorId;
        FirstClick = false; }   

console.log('ClickOne ' + ClickOne)
console.log('Clicktwo ' + ClickTwo)

var Start = Math.min(ClickOne, ClickTwo || 16);
var End = Math.max(ClickOne, ClickTwo || 0);

console.log('start ' + Start)
console.log('end ' + End)

    for (var i = Start; i <= End; i++) {
    $('#Color_' + i).addClass('SelectColor'); }

});

HouseVotes84是'mlbench'包中的数据集。

它将给出最大标签值。内置函数本身更容易使用而无需编写函数。

答案 27 :(得分:0)

可以尝试以下功能:

  1. 将数值转换为因子
  2. 使用summary()获取频率表
  3. 返回模式频率最大的索引
  4. 将数据转换为数字,即使有多个模式,此功能也能正常运行!
mode <- function(x){
  y <- as.factor(x)
  freq <- summary(y)
  mode <- names(freq)[freq[names(freq)] == max(freq)]
  as.numeric(mode)
}

答案 28 :(得分:0)

在我看来,如果集合具有模式,则可以将其元素与自然数一一对应。因此,查找模式的问题减少到生成此类映射,查找映射值的模式,然后映射回集合中的某些项目的问题。 (在映射阶段进行NA处理)。

我有一个histogram函数,它以相似的主体运行。 (此处提供的代码中使用的特殊功能和运算符应在Shapiro和/或neatOveRse中进行定义。此处复制的Shapiro和neatOveRse的部分经许可被复制;复制的摘录可以是(根据本网站的条款使用。)用于histogram的R 伪代码

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

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

(特殊的二进制运算符完成pipingcurryingcomposition)我也有一个maxloc函数,类似于which.max,但是返回 all 向量的绝对最大值。 maxloc的R 伪代码

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函数,就可以计算任何集合的模式。

答案 29 :(得分:0)

添加raster::modal()作为选项,但是请注意,raster是一个庞大的软件包,如果您不进行地理空间工作,可能不值得安装。

对于那些特别热衷的人,可以将源代码从https://github.com/rspatial/raster/blob/master/src/modal.cpphttps://github.com/rspatial/raster/blob/master/R/modal.R中拉出到个人R包中。

答案 30 :(得分:0)

现在CRAN上可用的 collapse 包中的通用函数fmode实现基于索引哈希的基于C ++的模式。它比上述任何一种方法都快得多。它带有向量,矩阵,data.frames和dplyr分组小标题的方法。语法:

fmode(x, g = NULL, w = NULL, ...)

其中x可以是上述对象之一,g提供一个可选的分组向量或分组向量列表(用于分组模式计算,也在C ++中执行),而w (可选)提供数字权重向量。在分组的tibble方法中,没有g参数,您可以执行data %>% group_by(idvar) %>% fmode

答案 31 :(得分:0)

如果您询问R中的内置函数,也许可以在软件包pracma中找到它。在该程序包的内部,有一个名为Mode的函数。

答案 32 :(得分:0)

这是我的 data.table 解决方案,它返回完整表的行模式。我用它来推断行类。它负责 data.table 中的 new-ish set() 函数,并且应该非常快。虽然它不管理 NA,但可以通过查看此页面上的众多其他解决方案来添加。

majorityVote <- function(mat_classes) {
  #mat_classes = dt.pour.centroids_num
  dt.modes <- data.table(mode = integer(nrow(mat_classes)))
  for (i in 1:nrow(mat_classes)) {
    cur.row <- mat_classes[i]
    cur.mode <- which.max(table(t(cur.row)))
    set(dt.modes, i=i, j="mode", value = cur.mode)
  }

  return(dt.modes)
}

可能的用法:

newClass <- majorityVote(my.dt)  # just a new vector with all the modes

答案 33 :(得分:-1)

您还可以计算实例在您的集合中发生的次数并找到最大数量。 e.g。

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

答案 34 :(得分:-1)

对不起,我可能会把它看得太简单,但是这不能做到这一点吗? (对于我机器上的1E6值,在1.3秒内):

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

你只需要更换&#34;轮(rnorm(1e6),2)&#34;用你的矢量。

答案 35 :(得分:-3)

计算包含离散值的矢量'v'的模式的简单方法是:

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