sourcedemos/magmas.xtl

1⍝!/usr/bin/env xetal 2⍝# Magmas: a set with a binary operation that stays in the set, and 3⍝# nothing more is promised. Rock-paper-scissors is one: x played against 4⍝# y gives the winner (x on a tie). With its table we can ask which laws 5⍝# hold, for every case at once. 6⍝# 7⍝# Run it with ./demos/magmas.xtl or "xetal run demos/magmas.xtl". It 8⍝# prints the Cayley tables of rock-paper-scissors and of its five-move 9⍝# extension, a 1 or 0 for each law checked, and draws the five-move 10⍝# table as an SVG file. Read the law checks: each is one comparison 11⍝# over a whole table, with no loop. 12 13⍝## Rock-paper-scissors 14 15⍝# The winner of x played against y, moves numbered 1 rock, 2 paper, 16⍝# 3 scissors; on a tie, x. 17ᵘr̲ps ← { x y → d ← (x − y) m̲od 3◆ y + (x − y) × d ≤ 1 } 18⍝# The move names, in the order of their numbers. 19names ← "rock" "paper" "scissors" 20⍝# The Cayley table of u:r_ps: row x, column y holds x against y. 21t ← (r̲ange 3) 'ᵘr̲ps t̲able r̲ange 3 22t ⍝ the Cayley table: 1 rock, 2 paper, 3 scissors 23t s̲elect names ⍝ the same, by name 24 25⍝## Laws 26 27⍝ The laws, as checks over the whole table. Associativity needs every 28⍝ triple x y z: the digits of 0 to n^3 - 1 in base n, by e_ncode. 29⍝# 'f u:c_ommutative n: 1 when f, on 1 to n, gives the same table with 30⍝# its arguments swapped, else 0. 31ᵘc̲ommutative ← { f̲ n → ((r̲ange n) 'f̲ t̲able r̲ange n) m̲atch (r̲ange n) '{ ⍵ f̲ ⍺ } t̲able r̲ange n } 32⍝# 'f u:i_dempotent n: 1 when x f x is x for every x in 1 to n, else 0. 33ᵘi̲dempotent ← { f̲ n → (r̲ange n) m̲atch '{ ⍵ f̲ ⍵ } e̲ach r̲ange n } 34⍝# 'f u:a_ssociative n: 1 when (x f y) f z equals x f (y f z) for every 35⍝# triple from 1 to n, else 0. 36ᵘa̲ssociative ← { f̲ n → 37 t ← 1 + (3 r̲eshape n) e̲ncode o̲ffsets n ^ 3 38 x ← 1 s̲elect t 39 y ← 2 s̲elect t 40 z ← 3 s̲elect t 41 '∧ r̲/ ((x f̲ y) f̲ z) = x f̲ y f̲ z 42} 43⍝# 'f u:i_dentity n: the element e of 1 to n with e f x and x f e both 44⍝# x for every x, or 0 when there is none. 45ᵘi̲dentity ← { f̲ n → ⍝ the identity element, or 0 for none 46 r ← r̲ange n 47 e ← w̲here '{ (r m̲atch ⍵ f̲ r) ∧ r m̲atch r f̲ ⍵ } e̲ach r 48 0 = t̲ally e ? 0◆ f̲irst e 49} 50'ᵘr̲ps ᵘc̲ommutative 3 51'ᵘr̲ps ᵘi̲dempotent 3 52'ᵘr̲ps ᵘa̲ssociative 3 ⍝ not associative 53'ᵘr̲ps ᵘi̲dentity 3 ⍝ no identity 54 55⍝ Not associative means the order of play matters: rock, paper, 56⍝ scissors from the right (reduce is a right fold) and from the left. 57'ᵘr̲ps r̲/ 1 2 3 ⍝ rock vs (paper vs scissors): rock 58(1 ᵘr̲ps 2) ᵘr̲ps 3 ⍝ (rock vs paper) vs scissors: scissors 59 60⍝## Other magmas 61 62⍝ Two more magmas on 1 2 3, to compare: addition modulo 3 (a group: 63⍝ associative, with an identity) and subtraction modulo 3 (neither). 64⍝# Addition modulo 3 on 1 2 3, where 1 stands for 0. 65ᵘa̲dd ← { x y → 1 + (x + y − 2) m̲od 3 } 66⍝# Subtraction modulo 3 on 1 2 3, where 1 stands for 0. 67ᵘs̲ub ← { x y → 1 + (x − y) m̲od 3 } 68'ᵘa̲dd ᵘc̲ommutative 3 69'ᵘa̲dd ᵘa̲ssociative 3 70'ᵘa̲dd ᵘi̲dentity 3 ⍝ 1 stands for 0 71'ᵘs̲ub ᵘc̲ommutative 3 72'ᵘs̲ub ᵘa̲ssociative 3 73 74⍝## Rock-paper-scissors-lizard-Spock 75 76⍝ Five moves, each beating two. In the order below, x beats y when 77⍝ (x - y) mod 5 is 1 or 2, so the rule is the same as before with 5 for 78⍝ 3 and 2 for 1. 79⍝# The winner of x played against y, moves numbered as in moves; on 80⍝# a tie, x. 81ᵘr̲psls ← { x y → d ← (x − y) m̲od 5◆ y + (x − y) × d ≤ 2 } 82⍝# The five move names, in the order of their numbers. 83moves ← "rock" "Spock" "paper" "lizard" "scissors" 84⍝# The Cayley table of u:r_psls. 85w ← (r̲ange 5) 'ᵘr̲psls t̲able r̲ange 5 86w s̲elect moves 87⍝# A 0/1 table: row x has a 1 in column y when x beats y. 88beats ← 0 + (r̲ange 5) '{ (⍺ ≠ ⍵) ∧ ⍺ = ⍺ ᵘr̲psls ⍵ } t̲able r̲ange 5 89beats ⍝ row x: the moves x beats 90'+ r̲/₂ beats ⍝ each beats two 91'+ r̲/ beats ⍝ and loses to two 92'ᵘr̲psls ᵘc̲ommutative 5 93'ᵘr̲psls ᵘi̲dempotent 5 94'ᵘr̲psls ᵘa̲ssociative 5 95⍝# The winner table drawn as a grid, written to an SVG file. 96shown ← ⎕S̲HOW ⎕G̲RID w ⍝ the winner table, colored by move