diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index 4760808944..6a93f2809e 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -80,3 +80,12 @@ IN: math.extras.test
 
 { { 1 8+4/5 16+3/5 24+2/5 32+1/5 } } [ 1 40 5 linspace[a,b) >array ] unit-test
 { { 1 10+3/4 20+1/2 30+1/4 40 } } [ 1 40 5 linspace[a,b] >array ] unit-test
+
+[ f ] [ { } majority ] unit-test
+[ 1 ] [ { 1 } majority ] unit-test
+[ f ] [ { 1 2 } majority ] unit-test
+[ 1 ] [ { 1 1 2 } majority ] unit-test
+[ f ] [ { 1 1 2 2 } majority ] unit-test
+[ 2 ] [ { 1 1 2 2 2 } majority ] unit-test
+[ 3 ] [ { 1 2 3 1 2 3 1 2 3 3 } majority ] unit-test
+{ CHAR: C } [ "AAACCBBCCCBCC" majority ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index abe99e9543..ee0aa6d40a 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -222,3 +222,10 @@ PRIVATE>
 
 : logspace[a,b] ( a b length base -- seq )
     [ linspace[a,b] ] dip swap n^v ;
+
+: majority ( seq -- elt/f )
+    [ f 0 ] dip [
+        over zero? [ 2nip 1 ] [
+            pick = [ 1 + ] [ 1 - ] if
+        ] if
+    ] each zero? [ drop f ] when ;