PROBLEM

Na podstawie dwóch słów znajdź zwycięzcę w cyfrowej bitwie o rootowanie .

Zdefiniuj cyfrowy pierwiastek słowa w ten sposób:

1. Każda litera alfabetu ma przypisany numer: A = 1, B = 2, C = 3, ..., Z = 26
2. Dodaj wartości dla każdej litery, aby zsumować słowo. Weźmy na przykład „CAT”. C + A + T = 3 + 1 + 20 = 24
3. Dodaj wszystkie pojedyncze cyfry, które składają się na wynik: 24 => 2 + 4 = 6
4. Powtarzaj krok # 3, aż dojdziesz do jednej cyfry. Ta pojedyncza cyfra jest cyfrowym rdzeniem słowa.

Zasady:

1. Zwycięzca zostaje ogłoszony, jeśli jego cyfrowy pierwiastek jest większy od drugiego.
2. Jeśli cyfrowe wartości główne są równe, skróć słowa, usuwając każde wystąpienie litery o największej wartości z obu słów i ponownie je obliczając.
3. Powtarzaj kroki 1 i 2, aż pojawi się zwycięzca lub jedno ze słów pozostanie tylko jedna litera (lub nie będzie żadnych liter).
4. Jeśli cyfrowe wartości root są równe po przejściu przez proces skracania, dłuższe słowo zostaje ogłoszone zwycięzcą.
5. Jeśli słowa są równej długości i po przejściu przez proces skracania nie zostanie znaleziony zwycięzca, nie zostanie ogłoszony zwycięzca.

Zasady specjalne:

1. Żadne użycie modułu nie jest dozwolone w obliczeniach samego cyfrowego pierwiastka . Można go używać gdziekolwiek indziej.
2. Załóżmy, że słowa będą się składać wyłącznie z wielkich liter - bez znaków interpunkcyjnych, bez spacji itp.

WKŁAD

Przeciągnij słowa przez stdin (oddzielone przecinkami). parametry metody lub jak chcesz. Wyjaśnij w swoim rozwiązaniu lub kodzie, w jaki sposób słowa są analizowane lub przygotowywane.

WYDAJNOŚĆ

Wyświetl zwycięskie słowo. Jeśli nie ma zwycięzcy, wyświetl „STALEMATE”.

Przykłady:

wejście: CAN, BAT

CAN = 18 = 9
BAT = 23 = 5 

wyjście: CAN

intput: ZOO, NO

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

OO = 30 = 3
N = 14 = 5

wyjście: NIE

AKTUALIZACJA : Dane wejściowe należy odczytać za pomocą stdin ze słowami jako ciąg rozdzielany przecinkami.

AKTUALIZACJA : Dodano kilka przykładów do przetestowania.

AKTUALIZACJA : wyjaśniono usunięcie najwyższej wartości litery w przypadku remisu - to również nieznacznie zmienia warunek zatrzymania - jeśli słowo ma długość jednej litery lub zero liter, proces skracania jest zatrzymywany

J, 100

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

działa w ten sposób:

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

nie akceptuje jeszcze danych wejściowych dokładnie takich, jakie zostały zadane.

APL (Dyalog) ( 91 86)

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

Objaśnienie (w kolejności wykonania):

• ⎕ML←3: ustaw ML na 3 ( ⊂między innymi oznacza to podział).
• G←Z⊂⍨','≠Z←⍞: odczytaj dane wejściowe, oddziel je przecinkami, zapisz w G i przekaż do funkcji.
• +/¨⎕A∘⍳¨⍵: oblicz wynik dla każdego słowa. ( ⎕Ajest listą zawierającą alfabet.)
• Z←{2>⍴⍕⍵:⍵⋄∇+/⍎¨⍕⍵}¨: oblicz cyfrowy pierwiastek dla każdego wyniku (sumując wszystkie cyfry, o ile jest ich więcej niż jedna cyfra) i zapisz je w Z.
• Z≡∪Z: jeśli wszystkie wyniki są unikalne ...
• :G[↑⍒Z]: ... następnie wypisz słowo o najwyższym wyniku (z oryginalnej listy).
• ⋄1∊↑¨⍴¨⍵:'STALEMATE': w przeciwnym razie (jeśli występuje remis), jeśli jedno ze słów ma długość 1, wypisz STALEMATE.
• ⋄∇1∘↓¨⍵: w przeciwnym razie zdejmij pierwszą literę z każdego słowa i ponownie uruchom funkcję.

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

Testy:

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

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

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

Haskell, 205 znaków

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(/=',')

Przykładowe przebiegi:

> 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

• Edycja: (227 -> 219) lepsze wybieranie zwycięzcy, skrócenie wzoru dopasowania w, importowanie starszego, krótszego modułu
• Edycja: (219 -> 208) Uwzględnij sugestie JB
• Edycja: (208 -> 205) obsługuje liczby ujemne, wykorzystując w Haskell dziwne reguły dotyczące łącznika

Perl, 224 225 229

Podstawowa gra w golfa (jeszcze nic mądrego):

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 i wyżej, uruchamiaj z perl -M5.010 <file>lubperl -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

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]

Używa obsługi wyjątków do wychwytywania błędów stosu, które powodują przypadki impasu.

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

Okazało się, że poniższy kod nie pasuje do specyfikacji, więc musiałem przerobić, dodając dużo długości (patrz wyżej). : - / Może być w stanie grać w golfa dalej, ale jest już dość kompaktowy i wątpię, czy uda mi się przywrócić go do konkurencyjnego wyniku.

Oryginał (poniżej) nie usunął litery o najwyższej wartości ze słów, gdy był remis.

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

To naprawdę mi się podobało i jest to mój pierwszy post. Chociaż jest stary, zauważyłem, że nikt nie zrobił wersji php, więc tutaj jest moja.

<?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 znaków.

Teraz nie jestem pewien co do zasad rozpoczynania, więc zacząłem od $ f = 'CAN, CBN' jako mojego wkładu. Mam nadzieję, że tak było. Przeprowadziłem wszystkie testy i wszystkie one przeszły pomyślnie, choć nie są szczególnie eleganckie. Naprawdę muszę się teraz trochę przespać, ale świetnie się przy tym bawiłem - dziękuję za świetną układankę.

Kod na http://codepad.org/ZSDuCdin

D: 326 znaków

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

Bardziej czytelnie:

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

Matematyka

Wciąż brakuje niektórych szczegółów

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

Mathematica 220 207

Po napisaniu tego zauważyłem, że wynika to z tego samego rozumowania, którego użył Belizariusz:

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

Stosowanie

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

Ponieważ odpowiedź nie jest konkurencyjna (jest tak długa), postanowiłem użyć formatu wejściowego bardziej zbliżonego do 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

Nie jestem tak zadowolony z tego, jak mógłbym być, ale i tak to postawię. Rzeczywista punktacja jest bardzo zwięzła ( yfunkcja), ale ifporównanie wyników (w z) jest dość długie.

Aby go użyć, zadzwoń za zpomocą dwóch słów (np z 'FOO','BAR'.). Wytypuje oba słowa i zwróci słowo o wyższej punktacji. Jeśli jest to remis, powtórzy się ze zmodyfikowanymi słowami (zatrzymując oryginały, aby w końcu powróciły, stąd dodatkowe dwa parametry), które otrzyma z xfunkcji.

Odpowiednik (rozszerzony) javascript dla zainteresowanych:

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, "");
    }
  }
};

Rakieta 479 bajtów

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

Nie golfowany:

(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)
          s
          (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))))
      (cond
        [(> a b) s]
        [(< a b) t]
        [(equal? l k) "STALEMATE"]
        [else (loop3 (remove* (list (apply max l)) l)
                     (remove* (list (apply max k)) k)
                     )]
        ))))

Testowanie:

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

Wydajność:

"CAN"
"NO"

PHP, 339 (nie podano), 410 382 359 339 337 bajtów

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

EDYCJA 1 : +71 bajtów. Używanie STDINzamiast fopen('php://stdin','r');i krótkich tagów. Ponadto pełna zgodność ze specyfikacją.

EDYCJA 2 : -28 bajtów. Używanie fgetcsv(STDIN)zamiast explode(',',trim(fgets(STDIN)))i używana forpętla zamiast whilepętli.

EDYCJA 3 : -23 bajty. Scalono funkcje ai bscalono dla pętli.

EDYCJA 4 : -20 bajtów. Przekształcony cz pętli rekurencyjnej. Następnie usunąłem funkcję ci umieściłem jej kod w globalnej przestrzeni nazw.

EDYCJA 5 : -2 bajty. Dzięki @Titus za -rflagę.

JAWA

    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){
            s1=0;
            for (int i=0;i<sum1.toString().length();i++)
                s1+=((int)sum1.toString().charAt(i)-48);
            sum1=s1;
        }
        while (sum2.toString().length()>1){
            s2=0;
            for (int i=0;i<sum2.toString().length();i++)
                s2+=((int)sum2.toString().charAt(i)-48);
            sum2 =s2;
        }
        flag=(s1>s2)?w1:(s1!=s2)?w2:"";
        if (flag!="")
            {st = new StringTokenizer(input,",");
                if (s1>s2)
                    System.out.println(st.nextToken());  
                else{
                    st.nextToken();
                    System.out.println(st.nextToken());
                }
            }
        int max=0;
        for (int i=0;i<w1.length();i++){
            max=((int)w1.charAt(i)>max)?(int)w1.charAt(i):max;
        }
        w1 = w1.replace((char)max, (char)64);
        max=0;
        for (int i=0;i<w2.length();i++){
            max=((int)w2.charAt(i)>max)?(int)w2.charAt(i):max;
        }
        w2 = w2.replace((char)max, (char)64);
            }while(flag=="" && !w1.equals(w2)); 
    if (flag.length()<1)
        System.out.println("STALEMATE");
        }

C ++, 473 (Pożyczam żelazko)

#include<iostream>
#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;}

Jestem pewien, że mógłbym to jakoś skrócić, ale jestem zmęczony.

Edycja: pierwotnie wziął argument wiersza poleceń, zmodyfikowany do użycia cin. Prawdopodobnie jest teraz o kilka znaków dłużej, ale jestem zbyt zmęczony, żeby to opisać.

Python: 383 znaków

uruchom funkcję c('CAN','BAT'):

def k(j):
 l=list(j);l.remove(max(j));return''.join(l)
def f(x):
 x=str(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):
 v=f(a);u=f(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 bajtów

Na razie nie jest konkurencyjny. Jestem pewien, że c może być krótszy, a także kilka ostatnich linii. Boli również brak dostępu do argumentów wiersza poleceń.

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
[<EntryPoint>]
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")
 0

Wypróbuj online!

• Zapisano 3 bajty, ograniczając s do łańcucha, porównując go z łańcuchem

Wersja bez golfa

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
    s.ToUpper()
    |>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
    else
        i

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

[<EntryPoint>]
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
                    3::state
                else if left > right then
                    0::state                // 0 is chosen because this represents y[0] index
                else
                    1::state
               ) [] (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" 
    0

PHP, 296 281 267 bajtów

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;

uruchom go -nlub wypróbuj online (TiO obejmuje awarię).

W lutym 2011 bieżąca wersja PHP miała wersję 5.3.5; więc nie mogłem

• użyj przypisania listy skrótów ( [$a,$b]=fgetcsv(...)i tak dalej)
• alias count_charsinline
• funkcja indeksu wyników bezpośrednio
• użyj ujemnych indeksów ciągów zamiast substr

Ale żadne z nich nie zaoszczędziłoby wiele; więc to nie ma większego znaczenia.

Najdroższe były pętle (oczywiście) i reguła nr 4 ( 40 36 bajtów).