SORUN

İki kelime göz önüne alındığında, kazanan bir dijital kök savaşta bulmak.

Bir kelimenin dijital kökünü şu şekilde tanımlayın :

1. Alfabenin her harfine bir sayı atanır: A = 1, B = 2, C = 3, ..., Z = 26
2. Kelimenin toplamını, her harf için değerleri ekleyin. Mesela "CAT" al. C + A + T = 3 + 1 + 20 = 24
3. Bu sonucu oluşturan tüm basamakları ekleyin: 24 => 2 + 4 = 6
4. Tek bir haneye ulaşana kadar 3. adımı tekrarlayın. Bu tek rakam, kelimenin dijital köküdür .

Kurallar:

1. Dijital kökünün diğerinden daha büyük olması durumunda kazanan ilan edilir .
2. Eğer dijital kök değerlerinin eşit olduğu, söz ve yeniden hesaplanıyor hem en yüksek değeri harfi her örneğini kaldırarak kelimeleri kısaltmak.
3. Bir kazanan veya kelimelerin birinde yalnızca tek bir harf (veya harf kalmadan) kalıncaya kadar # 1 ve # 2 numaralı adımları tekrarlayın .
4. Eğer dijital kök değerleri kısaltma işleminden geçtikten sonra eşitse, uzun kelime kazanan ilan edilir.
5. Eğer kelimeler aynı uzunluktasa ve kısaltma işleminden sonra kazanan bulunamazsa, kazanan ilan edilmez.

Özel kurallar:

1. Dijital kökün kendisinin hesaplanmasında modül kullanımına izin verilmez . Başka bir yerde kullanılabilir.
2. Kelimelerin yalnızca büyük harflerden oluşacağını varsayalım - noktalama işaretleri, boşluklar vb.

GİRİŞ

Kelimeleri stdin içinden (virgülle ayrılmış) çekin. yöntem parametreleri veya istediğiniz ancak. Çözümünüzdeki veya koddaki kelimelerin nasıl ayrıştırıldığı veya hazırlandığını açık bir şekilde belirtin.

ÇIKTI

Kazanan kelimeyi görüntüleyin. Kazanan yoksa, "STALEMATE" (STALEMATE) yazın.

Örnekler:

giriş: CAN, BAT

CAN = 18 = 9
BAT = 23 = 5 

çıkış: CAN

giriş: ZOO, NO

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

OO = 30 = 3
N = 14 = 5

çıkış: NO

GÜNCELLEME : Girdi, virgülle ayrılmış bir dizge olarak kelimelerle stdin kullanılarak okunmalıdır.

GÜNCELLEME : Test etmek için birkaç örnek eklendi.

GÜNCELLEME : kravat durumunda en yüksek değerli mektubun kaldırılmasını netleştirdi - bu aynı zamanda durma koşulunu da biraz değiştirir - eğer bir kelime bir harf veya sıfır harf uzunluğundaysa, kısalma işlemi durdurulur.

J, 100

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

böyle çalışır:

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

henüz tam olarak istendiği gibi girişi kabul etmiyor .

APL (Dyalog) ( 91 86)

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

Açıklama (yürütme sırasına göre):

• ⎕ML←3: ML’yi 3’e ayarlayın (bu, ⊂diğer şeylerin yanı sıra , ortalama bölümleme sağlar).
• G←Z⊂⍨','≠Z←⍞: girdiyi virgülle ayırarak oku, G de sakla ve işleve geç.
• +/¨⎕A∘⍳¨⍵: her kelime için skoru hesaplar. ( ⎕Aalfabeyi içeren bir listedir.)
• Z←{2>⍴⍕⍵:⍵⋄∇+/⍎¨⍕⍵}¨: Her skor için dijital kökü hesapla
• Z≡∪Z: eğer tüm puanlar eşsizse ...
• :G[↑⍒Z]: ... sonra en yüksek puana sahip kelimeyi (orijinal listeden) çıkar.
• ⋄1∊↑¨⍴¨⍵:'STALEMATE': Aksi takdirde (bir beraberlik varsa), kelimelerden biri uzunluk 1 ise, STALEMATE değerini girin.
• ⋄∇1∘↓¨⍵: aksi halde, her kelimeyi ilk harften alın ve işlevi tekrar çalıştırın.

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

Testler:

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

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

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

Haskell, 205 karakter

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

Örnek çalışır:

> 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

• Düzenleme: (227 -> 219) daha iyi w, daha kısa, daha kısa modül ithal , kazanan, kısaltılmış desen maçın daha iyi toplama
• Düzenleme: (219 -> 208) JB'nin önerilerini birleştir
• Düzenleme: (208 -> 205) Negatif sayıları işlemek, Haskell'de tire ile ilgili tuhaf kurallardan yararlanarak

Perl, 224 225 229

Temel golf (henüz akıllıca bir şey yok):

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

5.10 ve üzeri Perl, perl -M5.010 <file>veyaperl -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]

İstisna durumlarına neden olan yığın hatalarını yakalamak için istisna işlemeyi kullanır.

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

Aşağıdaki kodun özelliklere uymadığı ortaya çıktı, bu yüzden tekrar çalışmak zorunda kaldım, daha fazla uzunluk ekledim (yukarıya bakın). : - / Bu daha fazla golf oynayabilir, ancak zaten oldukça kompakt ve onu tekrar rekabetçi bir puana çıkarabileceğime şüpheliyim.

Orijinal (aşağıda), kravat olduğu zaman en değerli harfleri kelimelerden çıkarmadı.

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

Bu gerçekten benim fantezi aldı ve benim ilk yazı. Eski olmasına rağmen kimsenin php sürümü yapmadığını fark ettim, işte benimki.

<?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 Karakterler.

Şimdi başlangıç ​​kuralları konusunda emin değilim, bu yüzden girişim olarak $ f = 'CAN, CBN' ile başladım. Umarım bu haklıydı. Tüm testleri yaptım ve özellikle şık olmasa da hepsini geçtim. Şimdi gerçekten biraz uyumam gerekiyor ama bunu yaparken çok eğlendim - harika bir bulmaca için teşekkür ederim.

Http://codepad.org/ZSDuCdin’de kodlanmıştır

D: 326 Karakterler

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

Daha okunaklı:

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

Mathematica

Bazı detaylar hala eksik

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

Bunu yazdıktan sonra, bunun Belisarius'un kullandığı aynı mantığı takip ettiğini fark ettim.

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

kullanım

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

Cevap rekabetçi olmadığı için (çok uzun soluklu), Mathematica'ya daha uygun bir girdi formatı kullanmaya karar verdim.

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

Bu olabileceğim kadar mutlu değil, ama yine de koyacağım. Gerçek puanlama çok özlüdür ( yfonksiyon), ancak ifsonuçları karşılaştırmak için s zoldukça uzar.

Bunu kullanmak ziçin iki kelimenizle (örneğin z 'FOO','BAR') arayın . Her iki kelimeyi de puanlayacak ve daha yüksek puan alan kelimeyi geri getirecektir. Eğer bir bağ ise, fonksiyondan elde ettiği değiştirilmiş kelimelerle tekrar başlayacaktır (sonuçta orijinalleri geri getirecek, dolayısıyla ekstra iki parametre) x.

İlgilenenler için eşdeğer (genişletilmiş) javascript:

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

Raket 479 bayt

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

Ungolfed:

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

Test yapmak:

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

Çıktı:

"CAN"
"NO"

PHP, 339 (özel değil), 410 382 359 339 337 Bayt

$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 bayt. Kullanılması STDINyerine fopen('php://stdin','r');ve kısa etiketleri. Ayrıca, teknik özelliklere tam uygunluk.

EDIT 2 : -28 bayt. fgetcsv(STDIN)Bunun yerine kullanma explode(',',trim(fgets(STDIN)))ve fordöngü yerine kullanılan whiledöngü.

EDIT 3 : -23 bayt. Birleştirilmiş fonksiyonlar ave bdöngüler için birleştirilmiş.

EDIT 4 : -20 bayt. Çıktı cbir döngü halinde bir özyinelemeli gelen. Ardından, işlevi ckaldırın ve kodunu genel ad alanına yerleştirin.

EDIT 5 : -2 bayt. -rBayrak için @Titus'a teşekkürler .

JAVA

    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 (Ders demir ödünç alıyorum)

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

Eminim bir şekilde kısaltabilirim ama yoruldum.

Düzenleme: başlangıçta cin kullanmak için değiştirilmiş komut satırı argümanı aldı. Şimdi muhtemelen birkaç karakter daha uzun ama tekrar anlatmaya çok yoruldum.

Python: 383 karakter

işlevi çalıştır 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 bayt

Henüz rekabetçi değil. Son birkaç satırda olduğu gibi c de daha kısa yapılabildiğinden eminim . Komut satırlarına daha kolay erişememek de burada acı veriyor.

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

Çevrimiçi deneyin!

• String ile karşılaştırarak s dizesini sınırlayarak 3 bayt kurtarıldı

Ungolfed versiyonu

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 bayt

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;

çevrimiçi olarak çalıştırın -nveya deneyin (TiO'nun incelemesi dahil).

2011 yılının Şubat ayında, geçerli PHP sürümü 5.3.5 idi; bu yüzden yapamadım

• kestirme listesi ataması kullanın ( [$a,$b]=fgetcsv(...)ve benzeri)
• diğer ad count_charssatır içi
• endeks fonksiyonu sonuçları doğrudan
• yerine negatif dize dizinleri kullanın substr

Fakat ikisi de çok fazla tasarruf etmemeliydi; bu yüzden önemli değil.

En pahalı şeyler döngüler (elbette) ve kural # 4'tür ( 40 36 bayt).