Quiz #1
DistBurke=: 3 : '_13<\pc{~?~52'
⍝ You don't understand this
⍝ solution? (or maybe you only
⍝ understand this one!)
⍝ No surprise: it's not APL!
⍝ It's written in J!
⍝ Thanks Chris for having sent it
⍝ This solution and the
⍝ following ones from Chris
⍝ Burke assume the following
⍝ J global variables:
pips=: 'SHDC'
crds=: 'AKQJX98765432'
pc=: ,{pips;crds
∇ r←DistBusby
[1] r←⊂[2](,pips∘.,crds)[4 13⍴52?52]
∇
∇ r←DistGaveau
[1] r←,pips∘.,crds
[2] r←⎕split 4 13⍴r[52?52]
∇
∇ r←DistGlantz
[1] r←(52⍴13↑1)⎕penclose(,pips∘.,crds)[52?52]
∇
∇ r←DistHervy
[1] r←(52⍴13↑1)⎕penclose(,pips∘.,crds)[52?52]
∇
∇ r←DistHildebrand
[1] r←⎕split 4 13⍴(,pips∘.,crds)[52?52]
∇
∇ r←DistKoistinen
[1] r←⊂[2]4 13⍴(,⊂[1](1 52⍴pips),[1]52⍴crds)[52?52]
∇
∇ r←DistLescasse
[1] r←⊂[2](,pips∘.,crds)[4 13⍴52?52]
∇
∇ r←DistPrietto
[1] r←⊂[2]4 13⍴(,pips∘.,crds)[52?52]
∇
∇ DistMartin
[1] Dist:{4 13#-52?,/pips,/:\:crds}
∇
⍝ This solution to APL Quiz # 1 uses the K Language
⍝ It assumes:
pips:"SHDC" / S=Spades, H=Hearts, D=Diamonds, C=Clubs
crds:"AKQJX98765432" / A = Ace, K = King, Q = Queen, J = Jack, X = 10, 9 = 9, ...
∇ r←DistSimon
[1] r←(13/⍳4)⊂(,pips∘.,crds)[52?52]
∇
∇ r←DistSmith
[1] r←⊂[2](,pips∘.,crds)[4 13⍴52?52]
∇
∇ r←DistSykes
[1] r←⊂[2](,pips∘.,crds)[4 13⍴52?52]
∇
∇ r←DistWindal
[1] r←⎕split⍉(13,4)⍴(,pips∘.,crds)[52?52]
∇
Quiz #2
SortDistBurke=: (/: pc&i.) each
⍝ You don't understand this
⍝ solution? (or maybe you only
⍝ understand this one!)
⍝ No surprise: it's not APL!
⍝ It's written in J!
⍝ Thanks Chris for having sent it
∇ r←SortDistBusby a
[1] r←⊂[2]4 13⍴(,⊃a)[∊0 13 26 39+⍋¨(⊂,pips∘.,crds)⍳¨a]
∇
∇ r←SortDistGaveau a;b;i;k;j
[1] b←'ABCDEFGHIJKLM'
[2] i←b[4 13 1↑pips⍳⊃⊃a]
[3] j←b[4 13 ¯1↑crds⍳⊃⊃a]
[4] k←i,j
[5] k←(⊂⎕av)⍋¨(⊂13 2)⍴¨,¨1 1 1 1⎕penclose[1]k
[6] r←⎕split(52⍴⊃a)[⊃k+1 13 26 39]
∇
∇ r←SortDistGlantz a;b;d
[1] d←,pips∘.,crds
[2] r←''
[3] :for b :in a
[4] r,←⊂b[⍋d⍳b]
[5] :endfor
∇
∇ r←SortDistHervy a
[1] r←((⊂pips,crds)⍋¨⊃¨a)⊃¨¨⊂¨a
∇
∇ r←SortDistHildebrand a
[1] r←(⊂¨(⊂pips,crds)⍋¨⊃¨a)⌷¨a
∇
∇ r←SortDistKoistinen a;b
[1] b←⊂[1](1 52⍴⍉13 4⍴pips),[1]52⍴crds
[2] r←⊂[2]4 13⍴(,a)[,⊃0 13 26 39+⍋¨⊂[2]b⍳a←⊃a]
∇
∇ r←SortDistLescasse a
[1] a←(⊂¨⍋¨(⊂crds)⍳¨2⊃¨¨a)⌷¨a
[2] r←(⊂¨⍋¨(⊂pips)⍳¨1⊃¨¨a)⌷¨a
∇
∇ SortDistMartin
[1] SortDist:{x@'>:'x}
∇
⍝ This solution to APL Quiz # 2 uses the K Language
∇ r←SortDistPrietto a
[1] r←⊂[2](,⊃a)[(13×(¯1+⍳4))+[1]⊃⍋¨(⊂,pips∘.,crds)⍳¨a]
∇
∇ r←SortDistSimon a;c
[1] c←'swne'
[2] r←(13/⍳4)⊂⎕split 0 1↓a[(c,pips,crds)⍋a←(52⍴c),⊃,⊃a;]
∇
∇ r←SortDistSmith a
[1] r←pips,crds
[2] r←(⊂¨r∘⍋∘⊃¨a)⌷[1]¨a
∇
⍝ This solution has been written
⍝ and tested in NARS2000, a free
⍝ Open Source APL interpreter
⍝ developed by Bob Smith
⍝ It uses the Jot Compose operator
⍝ which is not supported by
⍝ APL+Win
∇ r←SortDistSwain a;d
[1] d←,pips∘.,crds
[2] r←(⊂¨⍋¨(⊂d)⍳¨a)⌷¨a
∇
∇ r←SortDistSykes a
[1] r←(⊂¨(⊂pips,crds)⍋¨⊃¨a)⌷¨a
∇
Quiz #3
∇ r←SplitBrenner a;d;h;i
[1] i←⊂[2]4 13⍴⍳52
[2] d←pips∘.,crds
[3] h←(⊂,d)⍳¨a
[4] a←(i∘.∊h)⎕repl¨⊂crds
[5] r←(⊂pips),¨,¨¨⊃¨⎕split⍉a
∇
∇ r←SplitBrenner2;d;e
[1] d←⊂[2]4 13⍴⍳52
[2] e←⊂[2]4 13⍴52?52
[3] r←(d∘.∊e)⎕repl¨⊂crds
∇
⍝ Although not quite matching the
⍝ Quiz requirements, this nice and
⍝ simple solution mostly solves all
⍝ first 3 quizzes at once!
SplitBrenner2
J32 X KQ9 A87654
AX763 85 Q942 KJ
2 X98653 KQJ4 A7
JX65 AK98 43 Q72
⍝ Note: the row order is
⍝ implicitely supposed to be:
⍝ S H D C
∇ r←SplitBrenner3;d;e
[1] d←⊂[2]4 13⍴⍳52
[2] e←⊂[2]4 13⍴52?52
[3] r←(d∘.∊e)⎕repl¨⊂crds
[4] r←(4 4⍴4/pips),¨r
∇
⍝ Same as SplitBrenner2 but with
⍝ the pips catenated to each hand
SplitBrenner3
SJX85 SQ942 SA63 SK7
H83 HA65 HKQJX92 H74
DJ9 DQX62 D74 DAK853
CX8432 C75 C96 CAKQJ
∇ r←SplitBrenner4;d;e
[1] d←⊂[2]4 13⍴⍳52
[2] e←⊂[2]4 13⍴52?52
[3] r←(d∘.∊e)⎕repl¨⊂crds
[4] r←(4 4⍴4/pips),¨r
[5] r←⊃¨⊂[2]⍉,¨¨r
∇
⍝ Same as SplitBrenner3 but with
⍝ the result conforming to the Quiz
⍝ requirements
SplitBrenner4
S J 6 5 4 S X 3 2 S A Q 7 S K 9 8
H J 2 H A Q X 8 7 3 H 9 6 5 4 H K
D A K X 7 3 D 8 2 D Q J 5 D 9 6 4
C A 5 C Q 7 C 8 3 2 C K J X 9 6 4
SplitBurke=: 3 : 'pips,.;"1 (pips=/{.&>y)#"1 ('' '',}.) each y' each
⍝ You don't understand this
⍝ solution? (or maybe you only
⍝ understand this one!)
⍝ No surprise: it's not APL!
⍝ It's written in J!
⍝ Thanks Chris for having sent it
∇ r←SplitBusby a;d
[1] ←⎕def'z←c d e' 'z←c/e'
[2] r←(⊂4 1⍴pips),¨⊃¨⊂[1]1↓¨¨(⊃(pips)∘.∊¨¨⊂a)d¨4 4⍴a
∇
∇ r←SplitGaveau a;c;d
[1] r←(⎕split⎕split∨/¨'S' 'H' 'D' 'C'∘.⍷⎕mix a)⎕repl¨¨4⍴⊂4⍴⊂⍳13
[2] d←1+⌈/¨⍴¨¨r
[3] c←1↓¨¨a
[4] r←(4 4⍴(∊'S')(∊'H')(∊'D')(∊'C')),⊃⍉(⊂¨⊃r)⌷¨4 4⍴c
[5] r←((4,∊d[1])↑r[1;;]) ((4,∊d[2])↑r[2;;])((4,∊d[3])↑r[3;;])((4,∊d[4])↑r[4;;])
∇
∇ r←SplitGlantz a;h;p;t
[1] r←''
[2] :for h :in a
[3] t←''
[4] :for p :in pips
[5] t,←⊂(⊂,p),1↓¨(p=∊1↑¨h)/h
[6] :endfor
[7] r,←⊂⊃t
[8] :endfor
∇
∇ r←SplitHervy a
[1] r←(⊂pips),¨⊃¨((⊂⍳⍴pips)∊¨a)⎕expand¨(a←(⊂pips)⍳¨↑¨¨a)⊂¨1↓¨¨a
∇
∇ r←SplitHildebrand a
[1] r←pips∘.=↑¨¨a
[2] r←⊃¨(⊂pips),¨¨(⎕split⍉r)⎕repl¨¨⊂¨1↓¨¨a
∇
∇ r←SplitHildebrand2 a;b
[1] b←pips∘.=↑¨¨a
[2] r←⊃¨(⊂pips),¨¨1↓¨¨¨(⎕split⍉b)⎕repl¨¨⊂¨a
∇
∇ r←SplitLescasse a;m
[1] m←(⊂pips)∊¨∪¨↑¨¨a
[2] r←(⊂pips),¨m⎕expand[1]¨⊃¨1↓¨¨¨((⊂pips)⍳¨↑¨¨a)⊂¨a
∇
∇ SplitMartin
[1] Split:{+{{-1_,/x}'((pips,'((*:'x)?pips)_(*:'∣:'x)),\:\:" ")}'x}
∇
⍝ This solution to APL Quiz # 3 uses the K Language
⍝ It assumes:
pips:"SHDC" / S=Spades, H=Hearts, D=Diamonds, C=Clubs
∇ r←SplitPrietto a;c
[1] a[((a←208⍴0)+,,c)/⍳⍴,,c←pips∘.∊↑¨⊃a]←,¯1↑¨⊃a
[2] r←,¨¨(⊃,/(pips,1⊃c)~¨0) (⊃,/(pips,2⊃c)~¨0) (⊃,/(pips,3⊃c)~¨0) (⊃,/(pips,4⊃c←⊂[1 3]4 4 13⍴a)~¨0)
∇
∇ r←SplitSimon2 a;d
[1] r←(⊃¨((~¨(,¨⊃¨1↑¨¨d)=¨1⌽¨,¨⊃¨1↑¨¨d)ר+\¨~¨(,¨⊃¨1↑¨¨d)=¨1⌽¨,¨⊃¨1↑¨¨d)⊂¨1↑¨¨d),¨⊃¨(,¨(⊂pips)⍳¨⊃¨1↑¨¨d)⊂¨¯1↑¨¨d←a
∇
∇ r←SplitSimon a;i
[1] r←(⊃¨((i≠¨1⌽¨i)רi)⊂¨1↑¨¨a),¨⊃¨(i←,¨(⊂pips)⍳¨⊃¨1↑¨¨a)⊂¨¯1↑¨¨a
∇
∇ r←SplitSmith a;c;s
[1] s←1⊃¨¨a
[2] c←2⊃¨¨a
[3] r←,¨¨pips∘,¨(pips∘∊¨s)⍀¨⊃¨' ',¨¨(s⍳¨s)⊂¨c
∇
⍝ This solution has been written
⍝ and tested in NARS2000, a free
⍝ Open Source APL interpreter
⍝ developed by Bob Smith
⍝ It uses the Jot (∘) Compose operator
⍝ and also uses the ⍀¨ operator
⍝ which are not supported by
⍝ APL+Win
∇ r←SplitSortSykes a;m;s
[1] s←(pips,crds)⍋m←(17/pips),68 2⍴(4 4 2⍴2/pips),[2]⊃⊃a
[2] r←⊃¨(4/⍳4)⊂(+\1,∨/2≠⌿m[s;1 2])⊂,¨m[s;3]
∇
⍝ SplitSortSykes solves both Split and
⍝ SortDist.
⍝
⍝ One can write either:
⍝
⍝ DisplaySykes SplitSykes SortDistSykes DistSykes
⍝ or
⍝ DisplaySykes SplitSortSykes SortDistSykes DistSykes
⍝ or
⍝ DisplaySykes SplitSortSykes DistSykes
⍝
⍝ The first is slowest, the last is fastest,
⍝ but speed is kind of beside the point.
⍝
⍝ The grade (⍋) in SplitSortSykes is mainly
⍝ performing a merge. The sort is a side
⍝ benefit. This is the fastest way to
⍝ segregate the suits (pips) -- faster
⍝ than the ∘.= algorithm in SplitSykes. It
⍝ is a very common technique in APL.
∇ r←SplitSykes a
[1] r←(⊂pips),¨⊃¨⊂[1](pips∘.=↑¨¨a)⎕repl¨4 4⍴1↓¨¨a
∇
Quiz #4
DisplayBurke=: 3 : 'y 1 3 5 7"_} 3 3$a:'
⍝ You don't understand this
⍝ solution? (or maybe you only
⍝ understand this one!)
⍝ No surprise: it's not APL!
⍝ It's written in J!
⍝ Thanks Chris for having sent it
∇ r←DisplayBusby a
[1] a[1 4]←(⌈/⍴¨a[1 4])↑¨a[1 4]
[2] r←3 3⍴(8⍴0 1)\a
∇
∇ r←DisplayGaveau a;b;c;d;e
[1] a[1 4]←(⌈/⍴¨a[1 4])↑¨a[1 4]
[2] r←∊4 ¯1↑⎕mix ⍴¨a
[3] e←⌈/r[1 4]
[4] b←(4,r[2])⍴' '⋄c←(4,r[3])⍴' '⋄d←(4,e)⍴' '
[5] r←3 3⍴b(1⊃a)c(2⊃a)d(3⊃a)b(4⊃a)c
∇
∇ r←DisplayGlantz a
[1] a[1 4]←(⌈/⍴¨a[1 4])↑¨a[1 4]
[2] r←3 3⍴(9⍴0 1)\a
∇
∇ r←DisplayHervy a
[1] r←3 3⍴(⊂''),[1.5](⌈/⍴¨a)↑¨a
∇
∇ r←DisplayHildebrand a
[1] r←3 3⍴⊂''
[2] r[(1 2)(2 1)(2 3)(3 2)]←⍕¨a
∇
∇ r←DisplayHildebrand2 r
[1] r←3 3⍴0 1 0 1 0 1 0 1\⍕¨r
∇
∇ r←DisplayLescasse a
[1] a[1 4]←(⌈/⍴¨a[1 4])↑¨a[1 4]
[2] r←(a,⊂'')[3 3⍴5,[1.5]⍳4]
∇
∇ DisplayMartin
[1] Display:{[dist]
[2] result:12 3#()
[3] result[0 1 2 3;1]:dist[;0]
[4] result[4 5 6 7;0]:dist[;1]
[5] result[4 5 6 7;2]:dist[;2]
[6] result[8 9 10 11;1]:dist[;3]
[7] :result
[8] }
∇
⍝ This solution to APL Quiz # 4 uses the K Language
∇ r←DisplayPrietto a
[1] r←⊃(((⍴2⊃a)⍴⊂''),1⊃a) ((2⊃a),((4,⌈/∊⍴¨a[1 4])⍴⊂''),3⊃a) (((⍴2⊃a)⍴⊂''),4⊃a)
∇
∇ r←DisplaySimon a
[1] a[1 4]←(⌈/⍴¨a[1 4])↑¨a[1 4]
[2] r←(a,⊂'')[3 3⍴5,[1.5]⍳4]
∇
∇ r←DisplaySmith a
[1] r←3 3⍴(9⍴0 1)\a
∇
⍝ This is a NARS2000 solution
⍝ Note that in NARS2000, the
⍝ alignment of the North and
⍝ South hands is perfect
⍝ with the above function
⍝ while in APL+Win it is not
⍝ and would require:
⍝
⍝ a[1 4]←(⌈/⍴¨a[1 4])↑¨a[1 4]
⍝
⍝ to be added to the function
∇ r←DisplaySykes a
[1] r←(⊂[2 3]⊃5↑a)[3 3⍴5,[1.5]⍳4]
∇
⍝ DisplaySykes simply takes advantage
⍝ of both the definition of fill item
⍝ for {over}take (↑), and the
⍝ characteristics of default
⍝ display.
Quiz #5
EvalBurke=: (+/@,@((i.5)*'XJQKA'=/;)) &>
⍝ You don't understand this
⍝ solution? (or maybe you only
⍝ understand this one!)
⍝ No surprise: it's not APL!
⍝ It's written in J!
∇ r←EvalBusby a
[1] r←+/¨+/5∣(⊂'JQKA')⍳¨⊃a
∇
∇ r←EvalGaveau a;s
[1] r←+/(s<5)×s←('JQKA'⍳⊃⊃a)[;;2]
∇
∇ r←EvalGlantz a
[1] r←+/(4 3 2 1 0)[4 13⍴'AKQJ'⍳∊1↓¨¨a]
∇
∇ r←EvalHervy a
[1] r←+/5-(4↑crds)⍳⊃∊¨a
∇
∇ r←EvalHildebrand r
[1] r←+/¨5∣(⊂'JQKA')⍳¨2⊃¨¨r
∇
∇ r←EvalLescasse a
[1] r←+/0⌈5-crds⍳⊃∊¨a
∇
∇ EvalMartin
[1] Eval:{{+/4 3 2 1*+/'"AKQJ"=\:x}'{*:'∣:'x}'x}
∇
⍝ This solution to APL Quiz # 5 uses the K Language
∇ r←EvalSimon a
[1] r←∊+⌿¨0⌈¯9+(⊂⌽crds)⍳¨⊃¨1↓¨¨a
∇
∇ r←EvalSykes a
[1] r←+/1 2 3 4 0['JQKA'⍳4 26⍴∊a]
∇
∇ r←EvalSykes2 a
[1] r←+/5∣'JQKA'⍳4 26⍴∊a
∇
∇ r←EvalSykes3 a
[1] r←+/4 3 2 1 0 0 0 0 0 0 0 0 0 0[crds⍳4 26⍴∊a]
∇
⍝ EvalSykes2 is shortest, but EvalSykes
⍝ is fastest. Direct translation
⍝ is almost always faster than
⍝ arithmetic operations; notably
⍝ modulus (∣) employs an implicit
⍝ division. Further, EvalSykes
⍝ and EvalSykes3 work in either origin.
∇ r←EvalWindal a
[1] r←+/4 13⍴((,0 1↓52 2⍴,⊃⊃a)∘.='AKQJ')+.×⊖⍳4
∇
Quiz #6
FindBurke=: 3 : 'while. y > Eval {. r=. Dist 0 do. end. Display Split SortDist r'
⍝ You don't understand this
⍝ solution? (or maybe you only
⍝ understand this one!)
⍝ No surprise: it's not APL!
⍝ It's written in J!
∇ r←FindBusby a;b;d
[1] :repeat ⋄ b←1↑Eval d←Dist ⋄ :until a≤b
[2] r←Display Split SortDist d
∇
∇ r←FindGlantz a;dist
[1] :if(a>37)∨a<0
[2] :return 'Invalid constraint. Must be between 0 and 37'
[3] :endif
[4]
[5] :while a>↑Eval dist←Dist
[6] :endwhile
[7]
[8] r←Display Split SortDist dist
∇
∇ r←FindHervy a;D;P;I;d;k;m;l;p
[1] a←0⌈37⌊a
[2] D←(⍳52),[.1]52⍴13↑4 3 2 1 ⍝ [1;]=cards, [2;]=points
[3] D←D[;52?52]
[4] :while a>+/d←13↑D[2;] ⍝ loop when North hand not strong enough
[5] l←13+13?39 ⍝ choose 13 cards among the other hands
[6] k←k/⍳⍴k←D[2;⍳13]≤D[2;l] ⍝ keeping only those which increase evaluation
[7] r←D[;k] ⍝ exchange D[;k] and D[;l[k]]
[8] D[;k]←D[;l[k]]
[9] D[;l[k]]←r
[10] :endwhile ⍝ there may be useless loops
[11] D←1+0 13⊤¯1+D[1;] ⍝ decoding hands
[12] r←⎕split 4 13⍴⎕split pips[D[1;]],[1.1]crds[D[2;]]
[13] r←Display Split SortDist r
∇
⍝ Note: all other solutions become
⍝ very slow when the argument is
⍝ higher than 28 and can even
⍝ not return answer for days
⍝ if the argument becomes close
⍝ to 37
⍝ This solution is optimized and
⍝ returns an answer instantaneously
⍝ whatever the argument is!
∇ r←FindHildebrand r;d
[1] :while r>↑EvalHildebrand d←Dist
[2] :end
[3] r←Display Split SortDist d
∇
∇ r←FindLescasse a
[1] :while a>↑Eval r←Dist ⋄ :endwhile
[2] r←Display Split SortDist r
∇
∇ FindMartin
[1] Find:{[limit]
[2] curr:SortDist Dist[]
[3] / Recursive solution only works up to 24
[4] / $[limit>*Eval curr;:Find limit;:Display Split curr]
[5] / Looping solution works up to 30
[6] while[limit>*Eval curr; curr:SortDist Dist[]]
[7] :Display Split curr
[8] }
∇
⍝ This solution to APL Quiz # 6 uses the K Language
∇ r←FindSimon2 a
[1] →1+a≤1⊃Eval r←Dist
[2] r←Display Split SortDist r
∇
∇ r←FindSimon a
[1] →1+a≤1⊃Eval r←SortDist Dist
[2] r←Display Split r
∇
∇ r←FindSykes a;e
[1] :while^/e←a>Eval r←Dist
[2] :end
[3] r←Display Split SortDist(¯1+e⍳0)⌽r
∇
⍝ Find can be much faster
⍝ than just looking at the
⍝ first hand of Dist,
⍝ particularly for large
⍝ arguments. It examines
⍝ all four generated hands,
⍝ then just shifts a passing
⍝ hand to the North position.