Question: My Word can beat up your Word

PROBLEM

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.

Rules:

  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.

INPUT

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.

OUTPUT

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

Examples:

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




11 answers

64.57% - Eelvex Best Answer

J, 100

z=:"."0@":@(+/)^:9@(64-~a.i.])@(#~' '&i.)"1
f=:*@-/"2@(z@((]#~]i.~{.@\:~)"1^:([:=/z))){'STALEMATE'&,

runs like this:

f 'NO',:'ZOO'
NO       
f 'CAN',:'BAT'
CAN      
f 'FAT',:'BANANA'
FAT      
f 'ONE',:'ONE'
STALEMATE

it doesn't yet accept input exactly as asked.


56.55% - user300

Ruby - 210

d,e=(a,b=$<.read.chop.split(/,/)).map{|w|w.bytes.sort}
r=->w,o=65{n=0;w.map{|c|n+=c-o};n>9?r[n.to_s.bytes,48]:n}
d.pop&e.pop while r[d]==r[e]&&d[1]&&e[1]
$><<[[:STALEMATE,a,b][a.size<=>b.size],a,b][r[d]<=>r[e]]

Tests:

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

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

$ ruby1.9 1128.rb <<< ZOO,ZOO
STALEMATE
56.55% - marinus

APL (Dyalog) (91 86)

⎕ML←3⋄{Z≡∪Z←{2>⍴⍕⍵:⍵⋄∇+/⍎¨⍕⍵}¨+/¨⎕A∘⍳¨⍵:G[↑⍒Z]⋄1∊↑¨⍴¨⍵:'STALEMATE'⋄∇1∘↓¨⍵}G←Z⊂⍨','≠Z←⍞

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.
51.01% - MtnViewMark

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"
main=getLine>>=putStrLn.w.span(/=',')

Sample runs:

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

> ./WordVsWord <<< CAN,BAT
CAN

> ./WordVsWord <<< ZOO,NO
NO

> ./WordVsWord <<< FAT,BANANA
FAT

> ./WordVsWord <<< ONE,ONE
STALEMATE

  • 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
43.85% - J B

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]}&&
redo}}say+("STALEMATE",@_)[$a<=>$b||@{$a[0]}<=>@{$a[1]}]

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

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

$ perl -M5.010 word.pl <<<NO,ON
STALEMATE
34.24% - tmartin

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.

20.65% - Jonathan M Davis

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;
                     })(b);
    int v = r!"a > b ? a : b"(s);

    writeln(count(s, v) > 1 ? "STALEMATE" : b[countUntil(s, v)]);
}
20.65% - belisarius

Mathematica

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

{"NO"}
20.65% - David Carraher

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

Usage

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

results

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

20.65% - Gaffi

VBA (242 462)

Function s(q,Optional l=0)
s=-1:t=Split(q,","):r=t:m=t
For j=0 To 1
m(j)=0:w=t(j)
While Len(w)>1 Or Not IsNumeric(w)
b=0
For i=1 To Len(w)
a=Mid(w,i,1):a=IIf(IsNumeric(a),a,Asc(a)-64):b=b+a
If m(j)+0<a+0 Then m(j)=a
Next
w=b
Wend
r(j)=b
Next
s=IIf(r(0)>r(1),0,IIf(r(0)<r(1),1,s))
For j=0 To 1
r(j)=Replace(t(j),Chr(m(j)+64),"",,1)
Next
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)
t=Split(q,",")
r=t
For j=0 To 1
w=t(j):b=0
For i=1 To Len(w)
b=b+Asc(Mid(w,i,1))-64
Next
While Len(b)>1
d=0
For i=1 To Len(b)
d=d+Mid(b,i,1)
Next
b=d
Wend
r(j)=b
Next
MsgBox IIf(r(0)>r(1),t(0),IIf(r(0)<r(1),t(1),"STALEMATE"))
End Sub
20.65% - Paul Drewett

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;}
while($c==''){$y1=splice($a,0);$y2=splice($b,0);$y3=splice($y1[0],1);
$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


Question and answers from http://codegolf.stackexchange.com/.