Twenty48.xtl

1⍝# 2048's rules, a library: 2048.xtl (scripted), play.xtl (at the
2⍝# terminal) and the web page all use these. Slide the tiles of a 4 by 4
3⍝# board left, right, up or down; two equal tiles that meet merge into
4⍝# their sum (once a move), and a 2 or a 4 appears on an empty square.
5⍝# Make a 2048 tile; the game ends when no move changes the board.
6⍝#
7⍝# The state is one vector: the score, then the 16 squares row by row
8⍝# (0 empty).
9
10⍝ :: a -> a
11⍝# The score so far.
12ˡs̲core ← { s → f̲irst s }
13⍝ :: a -> a
14⍝# The board, 4 by 4 (0 an empty square).
15ˡb̲oard ← { s → 4 4 r̲eshape 1 d̲rop s }
16
17⍝ :: (Num a, Truthy a) => a -> a
18⍝# Every row at once, its tiles slid left: each tile's new column is the
19⍝# count of tiles up to it in its row (a running sum); a 4 by 4 by 4
20⍝# table of each square against each column (row, old column, new
21⍝# column) puts every value in its place, summed over the old columns.
22ˡc̲ompress ← { b →
23  c ← (b ≠ 0) × '+ s̲\₂ b ≠ 0
24  '+ r̲/₂ (b 'l̲eft t̲able r̲ange 4) × c '= t̲able r̲ange 4
25}
26⍝ :: Num a => a -> Int
27⍝# Every row at once, which tiles double when equal neighbors merge,
28⍝# left to right: a run of equal tiles starts where a tile differs from
29⍝# the one before; each tile's place in its run is its column less the
30⍝# run's start (the latest start so far, by a max-scan). A tile in an
31⍝# odd place doubles when the next tile is equal; a tile in an even
32⍝# place is absorbed (the one before it doubled).
33ˡp̲lace ← { b →
34  j ← 4 4 r̲eshape r̲ange 4
35  prev ← 0 c̲at₂ -1 d̲rop₂ b
36  1 + j − 'm̲ax s̲\₂ j × b ≠ prev
37}
38⍝ :: (Num a, Truthy b) => a -> b
39⍝# Where a tile meets an equal one to its right in a row, the first of each pair (counted from the left).
40ˡd̲oubles ← { b →
41  next ← (1 d̲rop₂ b) c̲at₂ 0
42  (b ≠ 0) ∧ (1 = (ˡp̲lace b) m̲od 2) ∧ b = next
43}
44⍝ :: (Num a, Truthy a) => a -> a
45⍝# A row after merging: each first of a pair doubled, its partner emptied.
46ˡm̲erge ← { b → (b × 1 = (ˡp̲lace b) m̲od 2) + b × ˡd̲oubles b }
47⍝ :: (Num a, Truthy a) => a -> a
48⍝# A move left: compress, merge, compress, composed as a train of atops
49⍝# (each applied to the result of the one on its right).
50ˡl̲eft ← [ˡc̲ompress [ˡm̲erge ˡc̲ompress]]
51
52⍝ :: Num b => a -> b -> a
53⍝# The other moves turn the board so that the move is left, and turn it
54⍝# back: d is 1 left, 2 right, 3 up, 4 down. Up and down transpose the
55⍝# board (o_\) once, right and down reverse its rows once: each a power
56⍝# of 0 or 1. Turning back undoes them in the other order.
57ˡt̲urn ← { b d → (1 × d m̲ember? 2 4) 'r̲ev₂ p̲ower (1 × d m̲ember? 3 4) 'o̲\ p̲ower b }
58⍝ :: Num b => a -> b -> a
59⍝# The board turned back from the left-moving view of move d (undoing l:t_urn).
60ˡb̲ack ← { b d → (1 × d m̲ember? 3 4) 'o̲\ p̲ower (1 × d m̲ember? 2 4) 'r̲ev₂ p̲ower b }
61⍝ :: (Num a, Truthy a, Num b) => a -> b -> a
62⍝# Every tile of board b moved in direction d (1 left, 2 right, 3 up, 4 down): turned so the move is left, moved left, turned back.
63ˡs̲lide ← { b d → (ˡl̲eft b ˡt̲urn d) ˡb̲ack d }
64⍝ :: (Num a, Truthy a, Num b) => a -> b -> a
65⍝# What a move scores: the value of every tile it makes by merging.
66ˡg̲ain ← { b d →
67  c ← ˡc̲ompress b ˡt̲urn d
68  '+ r̲/ r̲avel 2 × c × ˡd̲oubles c
69}
70
71⍝ :: (Num a, Truthy a) => a -> a
72⍝# A 2 (or, one time in ten, a 4) on a random empty square.
73ˡs̲pawn ← { b →
74  e ← w̲here 0 = r̲avel b
75  0 = t̲ally e ? b
76  k ← (r̲oll! t̲ally e) s̲elect e
77  v ← 2 + 2 × 10 = r̲oll! 10
78  4 4 r̲eshape (r̲avel b) + v × k = r̲ange 16
79}
80⍝ :: (Any a, Num b, Truthy b) => a -> b
81⍝# A new game: no score, two tiles spawned on an empty board.
82ˡn̲ew ← { x → 0 c̲at r̲avel ˡs̲pawn ˡs̲pawn 4 4 r̲eshape 0 }
83
84⍝ :: (Num a, Truthy a, Num b) => a -> b -> a
85⍝# A move d: the board slides; if anything moved, the score gains the
86⍝# merged tiles and a new tile appears; if not, nothing happens.
87ˡm̲ove ← { s d →
88  b ← ˡb̲oard s
89  n ← b ˡs̲lide d
90  n m̲atch b ? s
91  ((ˡs̲core s) + b ˡg̲ain d) c̲at r̲avel ˡs̲pawn n
92}
93⍝ :: (Num a, Truthy a, Num b) => a -> b
94⍝# 0 playing, 1 a 2048 tile made, 2 no move changes the board.
95ˡs̲tatus ← { s →
96  b ← ˡb̲oard s
97  stuck ← '∧ r̲/ '{ (b ˡs̲lide ⍵) m̲atch b } e̲ach 1 2 3 4
98  f̲irst (((2048 m̲ember? r̲avel b) c̲at stuck) r̲eplicate 1 2) c̲at 0
99}