Given two words, find the winner in a digital root battle.

Define the digital root of a word this way:

  1. Each letter of the alphabet is assigned a number: A = 1, B = 2, C = 3, ..., Z = 26
  2. Add the values for each letter to total the word. Take "CAT", for example. C+A+T = 3+1+20 = 24
  3. Add all the single digits that make up that result: 24 => 2 + 4 = 6
  4. Repeat step #3 until you reach a single digit. That single digit is the digital root of the word.


  1. A winner is declared if its digital root is larger than the other.
  2. If the digital root values are equal, shorten the words by removing every instance of the highest value letter from both words and recalculating.
  3. Repeat steps #1 and #2 until there is a winner or one of the words has only a single letter (or no letters) remaining.
  4. If the digital root values are equal after going through the shortening process, the longer word is declared the winner.
  5. If the words are of equal length and no winner is found after going through the shortening process, no winner is declared.

Special rules:

  1. No use of modulus is allowed in the calculation of the digital root itself. It can be used anywhere else.
  2. Assume words will consist only of uppercase letters - no punctuation, no spaces, etc.


Pull the words in through stdin (comma-separated). method parameters, or however you want. Make it clear in your solution or the code how the words are parsed or prepared.


Display the winning word. If there is no winner, display "STALEMATE".


intput: CAN,BAT

CAN = 18 = 9
BAT = 23 = 5 

output: CAN

intput: ZOO,NO

ZOO = 56 = 11 = 2
NO = 29 = 11 = 2

OO = 30 = 3
N = 14 = 5

output: NO

UPDATE: Input must be read using stdin with the words as a comma-separated string.

UPDATE: Added a couple examples to test against.

UPDATE: clarified the removal of the highest valued letter in the case of a tie - this also alters slightly the stop condition as well - if a word is one letter or zero letters long, the shortening process is stopped

  • \$\begingroup\$ You should decide on the input, not leave it to choice, as it makes a huge difference in the programs. By picking an input method, and specing it, you remove "creative interpretations", and make a challenge that is equal for all. \$\endgroup\$ Commented Feb 22, 2011 at 3:17
  • 1
    \$\begingroup\$ @MtnViewMark - Understood, but effectively I'm trying to remove the reading of the input from the character count. I'm not interested in the most clever or shortest way to read in the two words. Requiring a specific method also handicaps certain languages - I guess I'm just trying to get at the meat of the problem. \$\endgroup\$
    – Steve
    Commented Feb 22, 2011 at 4:16
  • 1
    \$\begingroup\$ @Steve - Then you shouldn't specify the output as "display" either, yes? However, I think you are perhaps eliminating too much from the problem. A clever and short golf often stems from combining different aspects of the problem in tricky ways, for example folding some of the processing into the input or output. As for handicapping languages -- pretty much all of them can read stdin and write stdout. \$\endgroup\$ Commented Feb 22, 2011 at 4:22
  • \$\begingroup\$ @MtnViewMark - Fair point. I'll make a simple update and clear it up. My language of choice just has a lengthy way of reading from stdin, so I get biased. :) \$\endgroup\$
    – Steve
    Commented Feb 22, 2011 at 4:27
  • 2
    \$\begingroup\$ Would subtracting nine from the total value until it's less than ten be considered "using a modulus"? \$\endgroup\$
    – supercat
    Commented Feb 14, 2014 at 3:21

19 Answers 19


J, 100

z=:"."0@":@(+/)^:9@(64-~a.i.])@(#~' '&i.)"1

runs like this:

f 'NO',:'ZOO'
f 'CAN',:'BAT'
f 'ONE',:'ONE'

it doesn't yet accept input exactly as asked.


APL (Dyalog) (91 86)


Explanation (in order of execution):

  • ⎕ML←3: set ML to 3 (this makes mean partition, among other things).
  • G←Z⊂⍨','≠Z←⍞: read input, separate by commas, store in G and pass to the function.
  • +/¨⎕A∘⍳¨⍵: calculate the score for each word. (⎕A is a list containing the alphabet.)
  • Z←{2>⍴⍕⍵:⍵⋄∇+/⍎¨⍕⍵}¨: calculate the digital root for each score (by summing all digits as long as there is still more than one digit) and store them in Z.
  • Z≡∪Z: if all scores are unique...
  • :G[↑⍒Z]: ...then output the word with the highest score (from the original list).
  • ⋄1∊↑¨⍴¨⍵:'STALEMATE': otherwise (if there's a tie), if one of the words is of length 1, output STALEMATE.
  • ⋄∇1∘↓¨⍵: otherwise, take the first letter off each word and run the function again.

Ruby - 210

d.pop&e.pop while r[d]==r[e]&&d[1]&&e[1]


$ ruby1.9 1128.rb <<< CAN,BAT

$ ruby1.9 1128.rb <<< ZOO,NO

$ ruby1.9 1128.rb <<< ZOO,ZOO
  • \$\begingroup\$ First line can be shortened to d,e=(a,b=gets.split ?,).map{|w|w.bytes.sort}. \$\endgroup\$
    – Ventero
    Commented Feb 23, 2011 at 0:08
  • \$\begingroup\$ Why not shorten this further by using some other word to denote a tie? i.e. "TIE" vs. "STALEMATE" \$\endgroup\$
    – Gaffi
    Commented Aug 23, 2012 at 17:46
  • \$\begingroup\$ @Gaffi because the spec requires that the word "STALEMATE" be used. \$\endgroup\$ Commented Aug 23, 2012 at 21:51
  • \$\begingroup\$ @chron Shame on me, I stopped reading at "If the words are of equal length and no winner is found after going through the shortening process, no winner is declared." \$\endgroup\$
    – Gaffi
    Commented Aug 23, 2012 at 22:11

Haskell, 205 characters

import List
s b=d.sum.map((-b+).fromEnum)
d q|q<10=q|1<3=s 48$show q
f=map(s 64.concat).tails.group.reverse.sort
w(a,_:b)=f a#f b where x#y|x<y=b|x>y=a|1<3="STALEMATE"

Sample runs:

> ghc --make WordVsWord.hs 
[1 of 1] Compiling Main             ( WordVsWord.hs, WordVsWord.o )
Linking WordVsWord ...

> ./WordVsWord <<< CAN,BAT

> ./WordVsWord <<< ZOO,NO

> ./WordVsWord <<< FAT,BANANA

> ./WordVsWord <<< ONE,ONE

  • Edit: (227 -> 219) better picking of winner, shortened pattern match in w, imported older, shorter module
  • Edit: (219 -> 208) Incorporate JB's suggestions
  • Edit: (208 -> 205) handle negative numbers, exploiting odd rules in Haskell about hyphen
  • 1
    \$\begingroup\$ Using straight list comparison is a very nice touch. A few suggested "at-a-glance" improvements: ',':b_:b (-2), if you're not too attached to multiline processing interact$unlines.map([...]).linesputStr.[...]=<<getLine (-11), if you allow yourself to lax output putStrprint (-1). I hate those negation operation taking so many chars, but can't find a way around it. \$\endgroup\$
    – J B
    Commented Feb 23, 2011 at 9:15
  • \$\begingroup\$ Thanks, JB! I incorporated most of suggestions. I felt the output should follow the spec, in particular end with a newline. But I'd be willing to save those two characters if it got close! :-) \$\endgroup\$ Commented Feb 24, 2011 at 3:30
  • \$\begingroup\$ Good job with the subtractions! \$\endgroup\$
    – J B
    Commented Feb 24, 2011 at 7:31

Perl, 224 225 229

Basic golfing (nothing smart yet):

split",",<>;$_=[sort map-64+ord,/./g]for@a=@_;{for(@b=@a
){while($#$_){$s=0;$s+=$_ for@$_;$_=[$s=~/./g]}}($a,$b)=
map$$_[0],@b;if($a==$b){pop@$_ for@a;@{$a[1]}*@{$a[0]}&&

Perl 5.10 and above, run with perl -M5.010 <file> or perl -E '<code here>'

$ perl -M5.010 word.pl <<<CAN,BAT
$ perl -M5.010 word.pl <<<ZOO,NO

$ perl -M5.010 word.pl <<<NO,ON

K, 106

{a::x;@[{$[(>). m:{+/"I"$'$+/@[;x].Q.A!1+!26}'x;a 0;(<). m;a 1;.z.s 1_'x@'>:'x]};x;"STALEMATE"]}[","\:0:0]

Uses exception handling to catch stack errors, which result in cases of stalemate.


VBA (242 462)

Function s(q,Optional l=0)
For j=0 To 1
While Len(w)>1 Or Not IsNumeric(w)
For i=1 To Len(w)
If m(j)+0<a+0 Then m(j)=a
For j=0 To 1
If s<0 And Len(t(0))+Len(t(1))>2 Then s=s(r(0) & "," & r(1),1)
If l=0 Then If s>=0 Then s=t(s) Else s="STALEMATE"
End Function

Turns out the below code didn't match the spec, so I had to re-work, adding much length (see above). :-/ This may be able to be golfed further, but it's already pretty compact and I doubt I'll be able to bring it back down to a competitive score.

The original (below) did not remove the highest-valued letter from the words when there was a tie.

Sub s(q)
For j=0 To 1
For i=1 To Len(w)
While Len(b)>1
For i=1 To Len(b)
MsgBox IIf(r(0)>r(1),t(0),IIf(r(0)<r(1),t(1),"STALEMATE"))
End Sub

This really took my fancy and is my first post. Although it is old I noticed no one had done a php version so here is mine.

<?php $f='CAN,CBN';$w=explode(',',$f);$a=$ao=$w[0];$b=$bo=$w[1];$c='';
function splice($a,$t){$s=$h=0;$y=array();$x=str_split($a);
foreach($x as $k=>$v){$s=$s+ord($v)-64;if($v>$h){$h=$k;}}
$y[0]=$s;if($t==1){unset($x[$h1]);$y[1]=$x;}return $y;}
$y4=splice($y2[0],1);if($y3[0]>$y4[0]){$c=$ao;}else if($y3[0]<$y4[0]){$c=$bo;
}else if((strlen($a)<1)OR(strlen($b)<1)){if(strlen($a)<strlen($b)){$c=$ao;}
else if(strlen($b)<strlen($a)){$c=$bo;}else{$c='STALEMATE';}}}
echo $c;

534 Characters.

Now I am unsure as to the rules for starting off so I started with $f='CAN,CBN' as my input. I hope that was right. I have run all the tests and it passes all of them although it is not particularly elegant. I really must get some sleep now but I had great fun working this out - thank you for a great puzzle.

Coded on http://codepad.org/ZSDuCdin

  • \$\begingroup\$ You can use $f=trim(fgets(fopen('php://stdin'))); for taking the input. \$\endgroup\$
    – Lux
    Commented Jul 16, 2017 at 20:26
  • \$\begingroup\$ Scratch that, $w=fgetcsv(STDIN); works better. \$\endgroup\$
    – Lux
    Commented Jul 23, 2017 at 2:27

D: 326 Characters

import std.algorithm,std.array,std.conv,std.stdio;void main(string[]a){alias reduce r;auto b=array(splitter(a[1],","));auto s=map!((a){int n=r!"a+b"(map!"cast(int)(a-'A')+1"(a));while(n>9)n=r!"a+b"(map!"cast(int)(a-'0')"(to!string(n)));return n;})(b);int v=r!"a>b?a:b"(s);writeln(count(s,v)>1?"STALEMATE":b[countUntil(s,v)]);}

More Legibly:

import std.algorithm, std.array, std.conv, std.stdio;

void main(string[] a)
    alias reduce r;

    auto b = array(splitter(a[1], ","));
    auto s = map!((a){int n = r!"a + b"(map!"cast(int)(a - 'A') + 1"(a));

                      while(n > 9)
                          n = r!"a+b"(map!"cast(int)(a - '0')"(to!string(n)));

                      return n;
    int v = r!"a > b ? a : b"(s);

    writeln(count(s, v) > 1 ? "STALEMATE" : b[countUntil(s, v)]);


Some details still missing

a = {"ZOO"}; b = {"NO"}
f = FixedPoint[IntegerDigits@Total@# &, #] &

If[(s = f /@ 
        NestWhile[(# /. Max@# -> 0 &) /@ # &, (ToCharacterCode @@ # - 64) & /@ #, 
        f[#[[1]]] == f[#[[2]]] &, 1, 5] &@{a, b})[[1, 1]] > s[[2, 1]], 
   a, b, "STALMATE"]  


Mathematica 220 207

After writing this, I noticed that this follows the same reasoning that Belisarius used,

h@u_ := ToCharacterCode@u - 64;
m@w_ := FromCharacterCode[Most@Sort@h@w + 64];
f@v_ := FixedPoint[Tr@IntegerDigits@# &, Tr@h@v];
x_~g~y_ := If[f@x == f@y, g[m@x, m@y], If[f@x > f@y, 1, 2]];
x_~z~x_ := "STALEMATE";
x_~z~y_ := {x, y}[[x~g~y]] 


z["ZOO", "NO"]
z["CAN", "BAT"]
z["FAT", "BANANA"]
z["ONE", "ONE"]


Because the response is not competitive (being so long-winded), I decided to use an input format more congenial to Mathematica.


CoffeeScript - 335

z=(a,b,g=a,h=b)->c=y a;d=y b;e=a.length;f=b.length;return g if(c>d);return h if(d>c);return g if(e<2&&f>1);return h if(f<2&&e>1);return "STALEMATE" if(f==e&&f<2);z(x(a),x(b),a,b)
y=(a)->t=0;t+=c.charCodeAt(0)-1 for c in a;t-=9 while 9<t;t
x=(a)->for i in[90..65]
 b=new RegExp(String.fromCharCode(i));return a.replace b, "" if b.test a

Not as happy with this one as I might have been, but I'll put it up anyway. The actual scoring is very concise (y function), but the ifs to compare results (in z) get pretty long.

To use it call z with your two words (e.g. z 'FOO','BAR'). It will score both words and return the higher scoring word. If it's a tie, it will recurse with the modified words (keeping the originals to return eventually, hence the extra two parameters) which it gets from the x function.

The equivalent (expanded) javascript for those interested:

var x, y, z;

z = function(a, b, g, h) {
  var c, d, e, f;
  if (g == null) {
    g = a;
  if (h == null) {
    h = b;
  c = y(a);
  d = y(b);
  e = a.length;
  f = b.length;
  if (c > d) {
    return g;
  if (d > c) {
    return h;
  if (e < 2 && f > 1) {
    return g;
  if (f < 2 && e > 1) {
    return h;
  if (f === e && f < 2) {
    return "STALEMATE";
  return z(x(a), x(b), a, b);

y = function(a) {
  var c, t, _i, _len;
  t = 0;
  for (_i = 0, _len = a.length; _i < _len; _i++) {
    c = a[_i];
    t += c.charCodeAt(0) - 1;
  while (9 < t) {
    t -= 9;
  return t;

x = function(a) {
  var b, i, _i;
  for (i = _i = 90; _i >= 65; i = --_i) {
    b = new RegExp(String.fromCharCode(i));
    if (b.test(a)) {
      return a.replace(b, "");

Racket 479 bytes

(define(dl n)(let p((ol '())(n n))(let-values(((q r)(quotient/remainder n 10)))(if(= q 0)(cons r ol)(p(cons r ol)q)))))
(define(dr N)(let p2((n N))(define s(apply +(dl n)))(if(< s 10)s(p2 s))))
(let p3((l(for/list((i(string->list s)))(-(char->integer i)64)))(k(for/list((i(string->list t)))(-(char->integer i)64))))
(let((a(dr(apply + l)))(b(dr(apply + k))))(cond[(> a b)s][(< a b)t][(equal? l k)"STALEMATE"][else(p3(remove*(list(apply max l))l)(remove*(list(apply max k))k))])))


(define (f s t)

  (define (getDigitList n)                     ; sub-fn  to get digit list
    (let loop ((ol '())
               (n n))
      (let-values (((q r) (quotient/remainder n 10)))
        (if (= q 0) (cons r ol)
            (loop (cons r ol) q)))))

  (define (digit_root N)                       ; sub-fn to get digital root of a number
    (let loop2 ((n N))                        
      (define s (apply + (getDigitList n)))    
      (if (< s 10)
          (loop2 s))))

  (let loop3 ((l (for/list ((i (string->list s)))  ; actual fn to compare 2 strings
                   (- (char->integer i) 64)))
              (k (for/list ((i (string->list t)))
                   (- (char->integer i) 64))))
    (let ((a (digit_root (apply + l)))
          (b (digit_root (apply + k))))
        [(> a b) s]
        [(< a b) t]
        [(equal? l k) "STALEMATE"]
        [else (loop3 (remove* (list (apply max l)) l)
                     (remove* (list (apply max k)) k)


(f "CAN" "BAT")
(f "ZOO" "NO")




    public static void main(String args[]) throws Exception{
        String input=(new BufferedReader(new InputStreamReader(System.in)).readLine());
        StringTokenizer st = new StringTokenizer(input, ",");
        String w1 = st.nextToken();String w2 = st.nextToken();int s1=0;int s2=0;
        String flag="";
        do{ Integer sum1=0;Integer sum2=0;
        for (int i=0;i<w1.length();i++)
            sum1+=((int)w1.charAt(i) - 64);
        for (int i=0;i<w2.length();i++)
            sum2+=((int)w2.charAt(i) - 64);
        while (sum1.toString().length()>1){
            for (int i=0;i<sum1.toString().length();i++)
        while (sum2.toString().length()>1){
            for (int i=0;i<sum2.toString().length();i++)
            sum2 =s2;
        if (flag!="")
            {st = new StringTokenizer(input,",");
                if (s1>s2)
        int max=0;
        for (int i=0;i<w1.length();i++){
        w1 = w1.replace((char)max, (char)64);
        for (int i=0;i<w2.length();i++){
        w2 = w2.replace((char)max, (char)64);
            }while(flag=="" && !w1.equals(w2)); 
    if (flag.length()<1)
  • \$\begingroup\$ The code above replaces all max character in case of tie.. is that required? \$\endgroup\$ Commented Feb 22, 2011 at 14:39

C++, 473 (I'm borrowing a course iron)

#define $ string
#define _ return
using namespace std;$ S($&s){int i=-1,m=i,x=0;while(++i<s.length())if(s[i]-'@'>x)m=i,x=s[i];s.erase(m,1);_ s;}int M($ w){int i,v=0;for(i=0;i<w.length();++i)v+=w[i]-'@';while(v>9){i=0;while(v)i+=v-v/10*10,v/=10;v=i;}_ v;}$ B($ x, $ y){while(!(M(x)-M(y)))S(x),S(y);if(M(x)>M(y))_ x;if(M(x)<M(y))_ y;_"STALEMATE";}int main(int c,char**v){$ s;cin>>s;$ x=s.substr(0,s.find(',')),y=s.substr(s.find(',')+1);cout<<B(x,y)<<endl;_ 0;}

I'm sure I could shorten it up somehow, but I'm tired.

Edit: originally took command line argument, modified to use cin. It's probably a few characters longer now but I'm too tired to recount it.


Python :383 chars

run the function c('CAN','BAT'):

def k(j):
def f(x):
 if len(x)==1 and x.isdigit():return int(x)
 return f(sum('ABCDEFGHIJKLMNOPQRSTUVWXYZ'.index(y)+1 for y in x)) if x.isalpha() else f(sum(map(int,x)))
def c(a,b):
 if v>u:return a
 if v<u:return b
 return'STALEMATE' if v==u and (len(a)==1 or len(b)==1)else c(k(a),k(b))

F#, 559 533 530 bytes

Not competitive as of yet. I'm sure c can be made shorter as well as the last few lines. Not having easier access to command line args is also hurting here.

open System
let m=Seq.map
let a s=s="";s.ToUpper()|>m(fun c->int c-64)
let rec c i=if i>9 then string i|>m(int>>(-))|>m(fun x->x 48)|>Seq.sum|>c else i
let b i=Seq.fold(fun(r,a)j->(Seq.sum i-a)::r,a+j)([],0)(Seq.sortBy(~-)i)|>fst|>m c
let x z=
 let y=z.[0].Split(',')
 let u,v=y.[0].Length,y.[1].Length
 printf"%s"(Seq.fold2(fun s l r->if l=r then 3::s else if l>r then 0::s else 1::s)[](b<|a y.[0])(b<|a y.[1])|>Seq.tryFind((>)3)|>function|None when u>v->y.[0]|None when u<v->y.[1]|Some x->y.[x]|_->"STALEMATE")

Try it online!

  • Saved 3 bytes by constraining s to string by comparing it with string

Ungolfed version

open System
let m=Seq.map // this is just to save some characters and I'll use Seq.map for this version

let toIntList s =
    s = "" // constrain s to type string
    |>Seq.map (fun c -> int c - 64) // converts char value to int and offsets it so that A=1

let rec digitSumUntilSingle i =
    if i > 9 then
        string i                // convert number to string
        |>Seq.map ( int>>(-) )  // convert individual char to int and partially apply substraction
                                // this returns a function
        |>Seq.map (fun x -> x 48) // provide last parameter for substraction, this is equivalent to
                                  // charValue - 48
        |>Seq.sum                 // sum over all digits
        |>digitSumUntilSingle     // recursively call this function again in case we are >9

let calculateDigitalRoot input =
    Seq.fold(fun (result, acc) current ->       // calculate digital root for all possible iterations
                (Seq.sum input - acc)::result,  // basically, this calculates Rule 3 until the end for a given word
                acc + current
            ) ([], 0) (Seq.sortBy (~-) input) // sort input by value descending
    |>fst   // only interested in the lits, not the final accumulator
    |>Seq.map digitSumUntilSingle

let main (args) =
    let y = args.[0].Split(',')
    let leftLength = y.[0].Length
    let rightLength = y.[1].Length

    Seq.fold2 (fun state left right ->
                if left = right then
                else if left > right then
                    0::state                // 0 is chosen because this represents y[0] index
               ) [] (calculateDigitalRoot (toIntList y.[0])) (calculateDigitalRoot (toIntList y.[1]))
    |> Seq.tryFind ((>) 3)                  // try to find first variation where left and right digital root isn't equal
    |> function
        | None when leftLength > rightLength -> y.[0]
        | None when leftLength < rightLength -> y.[1]
        | Some x -> y.[x]
        | _ ->"STALEMATE"
    |>printf "%s" 

PHP, 339 (not to spec), 410 382 359 339 337 Bytes

$b=$w=fgetcsv(STDIN);function a($c){for(;a&$g=$c[$p++];)$f+=ord($g)-64;$f=trim($f);for(;$f[1]&a;$f=$h)for($h=0;a&$r=$f[$q++];$h=bcadd($h,$r));return$f;}function d($f){return strtr($f,[max(str_split($f))=>'']);}for(;$c==$d;$b=[$e,$f]){$x=$z++?d:trim;$e=$x($b[0]);$f=$x($b[1]);$c=a($e);$d=a($f);$e||die(STALEMATE);$c!=$d&&die($w[$c<=$d]);}

EDIT 1: +71 bytes. Using STDIN instead of fopen('php://stdin','r'); and short tags. Also, full conformance to the spec.

EDIT 2: -28 bytes. Using fgetcsv(STDIN) instead of explode(',',trim(fgets(STDIN))), and used for loop instead of while loop.

EDIT 3: -23 bytes. Merged functions a and b, merged for loops.

EDIT 4: -20 bytes. Turned c from a recursive into a loop. Then, removed function c and put its code into the global namespace.

EDIT 5: -2 bytes. Thanks to @Titus for the -r flag.

  • 1
    \$\begingroup\$ no need for a PHP tag with -r flag \$\endgroup\$
    – Titus
    Commented Sep 3, 2018 at 15:23

PHP, 296 281 267 bytes

function f(&$s){for(;$c=$s[$i++];$m>$c||$m=$c)$p+=ord($c)&31;for($s=str_replace($m,'',$s);9<$p=array_sum(str_split($p)););return$p;}for(list($a,$b)=$x=fgetcsv(STDIN);$s==$t&&$a&$b;$t=f($b))$s=f($a);echo($s-=$t)||($s=strlen($x[0])-strlen($x[1]))?$x[+($s<0)]:STALEMATE;

run with -n or try it online (TiO includes breakdown).

Back in Feb 2011, the current PHP version was 5.3.5; so I could not

  • use shorthand list assignment ([$a,$b]=fgetcsv(...) and such)
  • alias count_chars inline
  • index function results directly
  • use negative string indexes instead of substr

But neither would have saved a lot; so it doesn´t matter much.

Most costly things were the loops (of course) and rule #4 (40 36 bytes).


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.