2048: Difference between revisions
Content added Content deleted
m (→{{header|REXX}}: added wording to the REXX section header.) |
|||
Line 7,955: | Line 7,955: | ||
} |
} |
||
</lang> |
|||
=={{header|Racket}}== |
|||
Play the RacketScript fork online here: http://rapture.twistedplane.com:8080/#example/2048-game |
|||
<lang Racket> |
|||
;; LICENSE: See License file LICENSE (MIT license) |
|||
;; |
|||
;; Repository: https://github.com/danprager/2048 |
|||
;; |
|||
;; Copyright 2014: Daniel Prager |
|||
;; daniel.a.prager@gmail.com |
|||
;; |
|||
;; This is a largely clean-room, functional implementation in Racket |
|||
;; of the game 2048 by Gabriele Cirulli, based on 1024 by Veewo Studio, |
|||
;; and conceptually similar to Threes by Asher Vollmer. |
|||
;; |
|||
;; |
|||
;; HOW TO PLAY: |
|||
;; * Use your arrow keys to slide the tiles. |
|||
;; * When two tiles with the same number touch, they merge into one! |
|||
;; * Press <space> to rotate the board. |
|||
;; |
|||
#lang racket |
|||
(require rackunit |
|||
2htdp/image |
|||
(rename-in 2htdp/universe |
|||
[left left-arrow] |
|||
[right right-arrow] |
|||
[up up-arrow] |
|||
[down down-arrow])) |
|||
(define *side* 4) ; Side-length of the grid |
|||
(define *time-limit* #f) ; Use #f for no time limit, or number of seconds |
|||
(define *amber-alert* 60) ; Time indicator goes orange when less than this number of seconds remaining |
|||
(define *red-alert* 10) ; Time indicator goes red when less than this number of seconds remaining |
|||
(define *tile-that-wins* 2048) ; You win when you get a tile = this number |
|||
(define *magnification* 2) ; Scales the game board |
|||
(define (set-side! n) |
|||
(set! *side* n)) |
|||
;; |
|||
;; Numbers can be displayed with substiture text. Just edit this table... |
|||
;; |
|||
(define *text* |
|||
'((0 "") |
|||
(2 "2"))) |
|||
;; Color scheme |
|||
;; |
|||
;; From https://github.com/gabrielecirulli/2048/blob/master/style/main.css |
|||
;; |
|||
(define *grid-color* (color #xbb #xad #xa0)) |
|||
(define *default-tile-bg-color* (color #x3c #x3a #x32)) |
|||
(define *default-tile-fg-color* 'white) |
|||
(define *tile-bg-colors* |
|||
(map (lambda (x) |
|||
(match-define (list n r g b) x) |
|||
(list n (color r g b))) |
|||
'((0 #xcc #xc0 #xb3) |
|||
(2 #xee #xe4 #xda) |
|||
(4 #xed #xe0 #xc8) |
|||
(8 #xf2 #xb1 #x79) |
|||
(16 #xf5 #x95 #x63) |
|||
(32 #xf6 #x7c #x5f) |
|||
(64 #xf6 #x5e #x3b) |
|||
(128 #xed #xcf #x72) |
|||
(256 #xed #xcc #x61) |
|||
(512 #xed #xc8 #x50) |
|||
(1024 #xed #xc5 #x3f) |
|||
(2048 #xed #xc2 #x2e)))) |
|||
(define *tile-fg-colors* |
|||
'((0 dimgray) |
|||
(2 dimgray) |
|||
(4 dimgray) |
|||
(8 white) |
|||
(16 white) |
|||
(32 white) |
|||
(64 white) |
|||
(128 white) |
|||
(256 white) |
|||
(512 white) |
|||
(1024 white) |
|||
(2048 white))) |
|||
;;-------------------------------------------------------------------- |
|||
;; Rows may be represented as lists, with 0s representing empty spots. |
|||
;; |
|||
(define (nonzero? x) (not (zero? x))) |
|||
;; Append padding to lst to make it n items long |
|||
;; |
|||
(define (pad-right lst padding n) |
|||
(append lst (make-list (- n (length lst)) padding))) |
|||
;; Slide items towards the head of the list, doubling adjacent pairs |
|||
;; when no item is a 0. |
|||
;; |
|||
;; E.g. (combine '(2 2 2 4 4)) -> '(4 2 8) |
|||
;; |
|||
(define (combine lst) |
|||
(cond [(<= (length lst) 1) lst] |
|||
[(= (first lst) (second lst)) |
|||
(cons (* 2 (first lst)) (combine (drop lst 2)))] |
|||
[else (cons (first lst) (combine (rest lst)))])) |
|||
;; Total of new elements introduced by combining. |
|||
;; |
|||
;; E.g. (combine-total '(2 2 2 4 4)) -> 4 + 8 = 12 |
|||
;; |
|||
(define (combine-total lst) |
|||
(cond [(<= (length lst) 1) 0] |
|||
[(= (first lst) (second lst)) |
|||
(+ (* 2 (first lst)) (combine-total (drop lst 2)))] |
|||
[else (combine-total (rest lst))])) |
|||
;; Slide towards the head of the list, doubling pairs, 0 are |
|||
;; allowed (and slid through), and length is preserved by |
|||
;; padding with 0s. |
|||
;; |
|||
;; E.g. (slide-left '(2 2 2 0 4 4)) -> '(4 2 8 0 0 0) |
|||
;; |
|||
(define (slide-left row) |
|||
(pad-right (combine (filter nonzero? row)) 0 (length row))) |
|||
;; Slide towards the tail of the list: |
|||
;; |
|||
;; E.g. (slide-right '(2 2 0 0 4 4)) -> '(0 0 0 0 0 4 8) |
|||
;; |
|||
(define (slide-right row) (reverse (slide-left (reverse row)))) |
|||
;;-------------------------------------------------------------------- |
|||
;; We use a sparse representation for transitions in a row. |
|||
;; |
|||
;; Moves take the form '(value initial-position final-position) |
|||
;; |
|||
(define (moves-row-left row [last #f] [i 0] [j -1]) |
|||
(if (null? row) |
|||
null |
|||
(let ([head (first row)]) |
|||
(cond [(zero? head) (moves-row-left (rest row) last (add1 i) j)] |
|||
[(equal? last head) |
|||
(cons (list head i j) |
|||
(moves-row-left (rest row) #f (add1 i) j))] |
|||
[else (cons (list head i (add1 j)) |
|||
(moves-row-left (rest row) head (add1 i) (add1 j)))])))) |
|||
;; Convert a row into the sparse representaiton without any sliding. |
|||
;; |
|||
;; E.g. (moves-row-none '(0 2 0 4)) -> '((2 1 1) (4 3 3)) |
|||
;; |
|||
(define (moves-row-none row) |
|||
(for/list ([value row] |
|||
[i (in-naturals)] |
|||
#:when (nonzero? value)) |
|||
(list value i i))) |
|||
;; Reverse all moves so that: |
|||
;; |
|||
;; '(value initial final) -> '(value (- n initial 1) (- n final 1) |
|||
;; |
|||
(define (reverse-moves moves n) |
|||
(define (flip i) (- n i 1)) |
|||
(map (λ (m) |
|||
(match-define (list a b c) m) |
|||
(list a (flip b) (flip c))) |
|||
moves)) |
|||
(define (transpose-moves moves) |
|||
(for/list ([m moves]) |
|||
(match-define (list v (list a b) (list c d)) m) |
|||
(list v (list b a) (list d c)))) |
|||
(define (moves-row-right row [n *side*]) |
|||
(reverse-moves (moves-row-left (reverse row)) n)) |
|||
;;-------------------------------------------------------------------- |
|||
;; Lift the sparse representation for transitions |
|||
;; up to two dimensions... |
|||
;; |
|||
;; '(value initial final) -> '(value (x initial) (x final)) |
|||
;; |
|||
(define (add-row-coord i rows) |
|||
(for/list ([r rows]) |
|||
(match-define (list a b c) r) |
|||
(list a (list i b) (list i c)))) |
|||
(define (transpose lsts) |
|||
(apply map list lsts)) |
|||
;; Slide the entire grid in the specified direction |
|||
;; |
|||
(define (left grid) |
|||
(map slide-left grid)) |
|||
(define (right grid) |
|||
(map slide-right grid)) |
|||
(define (up grid) |
|||
((compose transpose left transpose) grid)) |
|||
(define (down grid) |
|||
((compose transpose right transpose) grid)) |
|||
;; Calculate the change to score from sliding the grid left or right. |
|||
;; |
|||
(define (score-increment grid) |
|||
(apply + (map (λ (row) |
|||
(combine-total (filter nonzero? row))) |
|||
grid))) |
|||
;; Slide the grid in the specified direction and |
|||
;; determine the transitions of the tiles. |
|||
;; |
|||
;; We'll use these operations to animate the sliding of the tiles. |
|||
;; |
|||
(define (moves-grid-action grid action) |
|||
(let ([n (length (first grid))]) |
|||
(apply append |
|||
(for/list ([row grid] |
|||
[i (in-range n)]) |
|||
(add-row-coord i (action row)))))) |
|||
(define (moves-grid-left grid) |
|||
(moves-grid-action grid moves-row-left)) |
|||
(define (moves-grid-right grid) |
|||
(moves-grid-action grid moves-row-right)) |
|||
(define (moves-grid-up grid) |
|||
((compose transpose-moves moves-grid-left transpose) grid)) |
|||
(define (moves-grid-down grid) |
|||
((compose transpose-moves moves-grid-right transpose) grid)) |
|||
;; Rotating the entire grid doesn't involve sliding. |
|||
;; It's a convenience to allow the player to view the grid from a different |
|||
;; orientation. |
|||
(define (moves-grid-rotate grid) |
|||
(let ([n (length (first grid))]) |
|||
(for/list ([item (moves-grid-action grid moves-row-none)]) |
|||
(match-define (list v (list i j) _) item) |
|||
(list v (list i j) (list j (- n i 1)))))) |
|||
;; Chop a list into a list of sub-lists of length n. Used to move from |
|||
;; a flat representation of the grid into a list of rows. |
|||
;; |
|||
;; |
|||
(define (chop lst [n *side*]) |
|||
(if (<= (length lst) n) |
|||
(list lst) |
|||
(cons (take lst n) (chop (drop lst n) n)))) |
|||
;; The next few functions are used to determine where to place a new |
|||
;; number in the grid... |
|||
;; |
|||
;; How many zeros in the current state? |
|||
;; |
|||
(define (count-zeros state) |
|||
(length (filter zero? state))) |
|||
;; What is the absolute index of the nth zero in lst? |
|||
;; |
|||
;; E.g. (index-of-nth-zero '(0 2 0 4) 1 2)) 1) -> 2 |
|||
;; |
|||
(define (index-of-nth-zero lst n) |
|||
(cond [(null? lst) #f] |
|||
[(zero? (first lst)) |
|||
(if (zero? n) |
|||
0 |
|||
(add1 (index-of-nth-zero (rest lst) (sub1 n))))] |
|||
[else (add1 (index-of-nth-zero (rest lst) n))])) |
|||
;; Place the nth zero in the lst with val. |
|||
;; |
|||
;; E.g. (replace-nth-zero '(0 2 0 4) 1 2)) -> '(0 2 2 4) |
|||
;; |
|||
(define (replace-nth-zero lst n val) |
|||
(let ([i (index-of-nth-zero lst n)]) |
|||
(append (take lst i) (cons val (drop lst (add1 i)))))) |
|||
;; There's a 90% chance that a new tile will be a two; 10% a four. |
|||
;; |
|||
(define (new-tile) |
|||
(if (> (random) 0.9) 4 2)) |
|||
;; Create a random initial game-board with two non-zeros (2 or 4) |
|||
;; and the rest 0s. |
|||
;; |
|||
;; E.g. '(0 0 0 0 |
|||
;; 0 2 0 0 |
|||
;; 2 0 0 0 |
|||
;; 0 0 0 0) |
|||
;; |
|||
(define (initial-state [side *side*]) |
|||
(shuffle (append (list (new-tile) (new-tile)) |
|||
(make-list (- (sqr side) 2) 0)))) |
|||
;; The game finishes when no matter which way you slide, the board doesn't |
|||
;; change. |
|||
;; |
|||
(define (finished? state [n *side*]) |
|||
(let ([grid (chop state n)]) |
|||
(for/and ([op (list left right up down)]) |
|||
(equal? grid (op grid))))) |
|||
;;-------------------------------------------------------------------- |
|||
;; Graphics |
|||
;; |
|||
(define *text-size* 30) |
|||
(define *max-text-width* 40) |
|||
(define *tile-side* 50) |
|||
(define *grid-spacing* 5) |
|||
(define *grid-side* (+ (* *side* *tile-side*) |
|||
(* (add1 *side*) *grid-spacing*))) |
|||
;; Memoization - caching images takes the strain off the gc |
|||
;; |
|||
(define-syntax define-memoized |
|||
(syntax-rules () |
|||
[(_ (f args ...) bodies ...) |
|||
(define f |
|||
(let ([results (make-hash)]) |
|||
(lambda (args ...) |
|||
((λ vals |
|||
(when (not (hash-has-key? results vals)) |
|||
(hash-set! results vals (begin bodies ...))) |
|||
(hash-ref results vals)) |
|||
args ...))))])) |
|||
;; Look-up the (i,j)th element in the flat representation. |
|||
;; |
|||
(define (square/ij state i j) |
|||
(list-ref state (+ (* *side* i) j))) |
|||
;; Linear interpolation between a and b: |
|||
;; |
|||
;; (interpolate 0.0 a b) -> a |
|||
;; (interpolate 1.0 a b) -> b |
|||
;; |
|||
(define (interpolate k a b) |
|||
(+ (* (- 1 k) a) |
|||
(* k b))) |
|||
;; Key value lookup with default return - is there an out-of-the-box function |
|||
;; for this? |
|||
;; |
|||
(define (lookup key lst default) |
|||
(let ([value (assoc key lst)]) |
|||
(if value (second value) default))) |
|||
;; Make a tile without a number on it in the appropriate color. |
|||
;; |
|||
(define (plain-tile n) |
|||
(square *tile-side* |
|||
'solid |
|||
(lookup n *tile-bg-colors* *default-tile-bg-color*))) |
|||
;; Make text for a tile |
|||
;; |
|||
(define (tile-text n) |
|||
(let* ([t (text (lookup n *text* (number->string n)) |
|||
*text-size* |
|||
(lookup n *tile-fg-colors* *default-tile-fg-color*))] |
|||
[side (max (image-width t) (image-height t))]) |
|||
(scale (if (> side *max-text-width*) (/ *max-text-width* side) 1) t))) |
|||
(define-memoized (make-tile n) |
|||
(overlay |
|||
(tile-text n) |
|||
(plain-tile n))) |
|||
;; Place a tile on an image of the grid at (i,j) |
|||
;; |
|||
(define (place-tile/ij tile i j grid-image) |
|||
(define (pos k) |
|||
(+ (* (add1 k) *grid-spacing*) |
|||
(* k *tile-side*))) |
|||
(underlay/xy grid-image (pos j) (pos i) tile)) |
|||
;; Make an image of the grid from the flat representation |
|||
;; |
|||
(define *last-state* null) ; Cache the previous grid to avoid |
|||
(define *last-grid* null) ; senseless regeneration |
|||
(define (state->image state) |
|||
(unless (equal? state *last-state*) |
|||
(set! *last-grid* |
|||
(for*/fold ([im (square *grid-side* 'solid *grid-color*)]) |
|||
([i (in-range *side*)] |
|||
[j (in-range *side*)]) |
|||
(place-tile/ij (make-tile (square/ij state i j)) |
|||
i j |
|||
im))) |
|||
(set! *last-state* state)) |
|||
*last-grid*) |
|||
(define *empty-grid-image* |
|||
(state->image (make-list (sqr *side*) 0))) |
|||
;; Convert the sparse representation of moves into a single frame in an |
|||
;; animation at time k, where k is between 0.0 (start state) and 1.0 |
|||
;; (final state). |
|||
;; |
|||
(define (moves->frame moves k) |
|||
(for*/fold ([grid *empty-grid-image*]) |
|||
([m moves]) |
|||
(match-define (list value (list i1 j1) (list i2 j2)) m) |
|||
(place-tile/ij (make-tile value) |
|||
(interpolate k i1 i2) (interpolate k j1 j2) |
|||
grid))) |
|||
;; Animation of simultaneously moving tiles. |
|||
;; |
|||
(define (animate-moving-tiles state op) |
|||
(let ([grid (chop state)]) |
|||
(build-list 9 (λ (i) |
|||
(λ () |
|||
(moves->frame (op grid) |
|||
(* 0.1 (add1 i)))))))) |
|||
;; Animation of a tile appearing in a previously blank square. |
|||
;; |
|||
(define (animate-appearing-tile state value index) |
|||
(let ([start (state->image state)] |
|||
[tile (make-tile value)] |
|||
[i (quotient index *side*)] |
|||
[j (remainder index *side*)]) |
|||
(build-list 4 (λ (m) |
|||
(λ () |
|||
(place-tile/ij (overlay |
|||
(scale (* 0.2 (add1 m)) tile) |
|||
(plain-tile 0)) |
|||
i j |
|||
start)))))) |
|||
;;-------------------------------------------------------------- |
|||
;; |
|||
;; The Game |
|||
;; |
|||
;; an image-procedure is a procedure of no arguments that produces an image |
|||
;; a world contains: |
|||
;; state is a ? |
|||
;; score is a number |
|||
;; winning-total is #f or a number, representing the final score <-- is this |
|||
;; necessary? |
|||
;; frames is a (list-of image-procedure) |
|||
;; start-time is a number, in seconds |
|||
(define-struct world (state score winning-total frames start-time) #:transparent) |
|||
;; The game is over when any animations have been finished and |
|||
;; no more moves are possible. |
|||
;; |
|||
;; note that winning the game does *not* end the game. |
|||
;; |
|||
(define (game-over? w) |
|||
(match-define (world state score wt frames start-time) w) |
|||
(and (null? frames) ; Finish animations to reach final state and show the banner |
|||
(or (finished? state) |
|||
(out-of-time? (world-start-time w))))) |
|||
;; Is the player out of time? |
|||
(define (out-of-time? start-time) |
|||
(and *time-limit* (< (+ start-time *time-limit*) (current-seconds)))) |
|||
;; Given an arrow key return the operations to change the state and |
|||
;; produce the sliding animation. |
|||
;; |
|||
(define (key->ops a-key) |
|||
(cond |
|||
[(key=? a-key "left") (list left moves-grid-left)] |
|||
[(key=? a-key "right") (list right moves-grid-right)] |
|||
[(key=? a-key "up") (list up moves-grid-up)] |
|||
[(key=? a-key "down") (list down moves-grid-down)] |
|||
[else (list #f #f)])) |
|||
;; Respond to a key-press |
|||
;; |
|||
(define (change w a-key) |
|||
(match-let ([(list op moves-op) (key->ops a-key)] |
|||
[(world st score wt frames start-time) w]) |
|||
(cond [(out-of-time? start-time) w] ; Stop accepting key-presses |
|||
[op |
|||
(let* ([grid (chop st)] |
|||
[slide-state (flatten (op grid))]) |
|||
(if (equal? slide-state st) |
|||
w ; sliding had no effect |
|||
(let* ([replace (random (count-zeros slide-state))] |
|||
[index (index-of-nth-zero slide-state replace)] |
|||
[value (new-tile)] |
|||
[new-state (replace-nth-zero slide-state replace value)] |
|||
[horizontal? (member a-key (list "left" "right"))]) |
|||
(make-world new-state |
|||
(+ score (score-increment |
|||
(if horizontal? grid (transpose grid)))) |
|||
(cond [wt wt] |
|||
[(won-game? new-state) |
|||
(apply + (flatten new-state))] |
|||
[else #f]) |
|||
(append frames |
|||
(animate-moving-tiles st moves-op) |
|||
(animate-appearing-tile slide-state value index)) |
|||
start-time))))] |
|||
[(key=? a-key " ") ; rotate the board |
|||
(make-world ((compose flatten transpose reverse) (chop st)) |
|||
score wt |
|||
(append frames |
|||
(animate-moving-tiles st moves-grid-rotate)) |
|||
start-time)] |
|||
[else w]))) ; unrecognised key - no effect |
|||
;; Are we there yet? |
|||
;; |
|||
(define (won-game? state) |
|||
(= (apply max state) *tile-that-wins*)) |
|||
;; Banner overlay text: e.g. You won! / Game Over, etc. |
|||
;; |
|||
(define (banner txt state [color 'black]) |
|||
(let ([b-text (text txt 30 color)]) |
|||
(overlay |
|||
b-text |
|||
(rectangle (* 1.2 (image-width b-text)) |
|||
(* 1.4 (image-height b-text)) |
|||
'solid 'white) |
|||
(state->image state)))) |
|||
;; Convert number of seconds to "h:mm:ss" or "m:ss" format |
|||
;; |
|||
(define (number->time-string s) |
|||
(define hrs (quotient s 3600)) |
|||
(define mins (quotient (remainder s 3600) 60)) |
|||
(define secs (remainder s 60)) |
|||
(define (xx n) |
|||
(cond [(<= n 0) "00"] |
|||
[(<= n 9) (format "0~a" n)] |
|||
[else (remainder n 60)])) |
|||
(if (>= s 3600) |
|||
(format "~a:~a:~a" hrs (xx mins) (xx secs)) |
|||
(format "~a:~a" mins (xx secs)))) |
|||
(define (time-remaining start) |
|||
(+ *time-limit* start (- (current-seconds)))) |
|||
(define (time-elapsed start) |
|||
(- (current-seconds) start)) |
|||
;; Display the grid with score below. |
|||
;; |
|||
;; If there are frames, show the next one. Otherwise show the steady state. |
|||
;; |
|||
(define (show-world w) |
|||
(match-define (world state score wt frames start-time) w) |
|||
(let* ([board (if (null? frames) |
|||
(cond [(finished? state) (banner "Game over" state)] |
|||
[(out-of-time? start-time) (banner "Out of Time" state 'red)] |
|||
;; Q: Why wt (i.e. winning-total) rather than won-game? |
|||
;; A: wt allows the keen player to continue playing... |
|||
[(equal? (apply + (flatten state)) wt) (banner "You won!" state)] |
|||
[else (state->image state)]) |
|||
((first frames)))] |
|||
[score-text (text (format "Score: ~a" score) 16 'dimgray)] |
|||
[seconds ((if *time-limit* time-remaining time-elapsed) start-time)] |
|||
[time-text (text (format "Time: ~a" |
|||
(number->time-string seconds)) |
|||
16 |
|||
(cond [(or (> seconds *amber-alert*) (not *time-limit*)) 'gray] |
|||
[(> seconds *red-alert*) 'orange] |
|||
[else 'red]))]) |
|||
(scale *magnification* |
|||
(above |
|||
board |
|||
(rectangle 0 5 'solid 'white) |
|||
(beside |
|||
score-text |
|||
(rectangle (- (image-width board) |
|||
(image-width score-text) |
|||
(image-width time-text)) 0 'solid 'white) |
|||
time-text))))) |
|||
;; Move to the next frame in the animation. |
|||
;; |
|||
(define (advance-frame w) |
|||
(match-define (world state score wt frames start-time) w) |
|||
(if (null? frames) |
|||
w |
|||
(make-world state score wt (rest frames) start-time))) |
|||
;; Use this state to preview the appearance of all the tiles |
|||
;; |
|||
(define (all-tiles-state) |
|||
(let ([all-tiles '(0 2 4 8 16 32 64 128 256 512 1024 2048 4096)]) |
|||
(append all-tiles (make-list (- (sqr *side*) (length all-tiles)) 0)))) |
|||
;; The event loop |
|||
;; |
|||
(define (start) |
|||
(big-bang (make-world (initial-state) |
|||
;(all-tiles-state) |
|||
0 #f null (current-seconds)) |
|||
(to-draw show-world) |
|||
(on-key change) |
|||
(on-tick advance-frame 0.01) |
|||
(stop-when game-over? show-world) |
|||
(name "2048 - Racket edition"))) |
|||
;; |
|||
;; TESTS |
|||
;; |
|||
(module+ test |
|||
(set-side! 4) |
|||
(check-equal? (slide-left '(0 0 0 0)) '(0 0 0 0)) |
|||
(check-equal? (slide-left '(1 2 3 4)) '(1 2 3 4)) |
|||
(check-equal? (slide-left '(2 0 4 0)) '(2 4 0 0)) |
|||
(check-equal? (slide-left '(0 0 2 4)) '(2 4 0 0)) |
|||
(check-equal? (slide-left '(2 0 2 0)) '(4 0 0 0)) |
|||
(check-equal? (slide-left '(0 8 8 0)) '(16 0 0 0)) |
|||
(check-equal? (slide-left '(4 4 8 8)) '(8 16 0 0)) |
|||
(check-equal? (slide-right '(4 4 8 8)) '(0 0 8 16)) |
|||
(check-equal? (slide-right '(4 4 4 0)) '(0 0 4 8)) |
|||
(check-equal? (moves-row-left '(0 0 0 0)) '()) |
|||
(check-equal? (moves-row-left '(1 2 3 4)) |
|||
'((1 0 0) |
|||
(2 1 1) |
|||
(3 2 2) |
|||
(4 3 3))) |
|||
(check-equal? (moves-row-left '(2 0 4 0)) '((2 0 0) |
|||
(4 2 1))) |
|||
(check-equal? (moves-row-right '(2 0 4 0)) '((4 2 3) |
|||
(2 0 2))) |
|||
(check-equal? (moves-row-left '(0 0 2 4)) '((2 2 0) |
|||
(4 3 1))) |
|||
(check-equal? (moves-row-left '(2 0 2 0)) '((2 0 0) |
|||
(2 2 0))) |
|||
(check-equal? (moves-row-left '(2 2 2 0)) '((2 0 0) |
|||
(2 1 0) |
|||
(2 2 1))) |
|||
(check-equal? (moves-row-right '(2 2 2 0)) '((2 2 3) |
|||
(2 1 3) |
|||
(2 0 2))) |
|||
(check-equal? (moves-row-left '(2 2 4 4)) '((2 0 0) |
|||
(2 1 0) |
|||
(4 2 1) |
|||
(4 3 1))) |
|||
(check-equal? (moves-row-right '(2 2 4 4)) '((4 3 3) |
|||
(4 2 3) |
|||
(2 1 2) |
|||
(2 0 2))) |
|||
(check-equal? (add-row-coord 7 '((2 0 0) |
|||
(2 1 0) |
|||
(4 2 1))) |
|||
'((2 (7 0) (7 0)) |
|||
(2 (7 1) (7 0)) |
|||
(4 (7 2) (7 1)))) |
|||
(check-equal? (left '(( 0 8 8 0) |
|||
(16 0 0 0) |
|||
( 2 2 4 4) |
|||
( 0 2 2 2))) |
|||
'((16 0 0 0) |
|||
(16 0 0 0) |
|||
( 4 8 0 0) |
|||
( 4 2 0 0))) |
|||
(check-equal? (right '(( 0 8 8 0) |
|||
(16 0 0 0) |
|||
( 2 2 4 4) |
|||
( 0 2 2 2))) |
|||
'((0 0 0 16) |
|||
(0 0 0 16) |
|||
(0 0 4 8) |
|||
(0 0 2 4))) |
|||
(check-equal? (up '((0 16 2 0) |
|||
(8 0 2 2) |
|||
(8 0 4 2) |
|||
(0 0 4 2))) |
|||
'((16 16 4 4) |
|||
(0 0 8 2) |
|||
(0 0 0 0) |
|||
(0 0 0 0))) |
|||
(check-equal? (down '((0 16 2 0) |
|||
(8 0 2 2) |
|||
(8 0 4 2) |
|||
(0 0 4 2))) |
|||
'((0 0 0 0) |
|||
(0 0 0 0) |
|||
(0 0 4 2) |
|||
(16 16 8 4))) |
|||
(check-equal? (left '(( 0 8 8 0) |
|||
(16 0 0 0) |
|||
( 2 2 4 4) |
|||
( 0 2 2 2))) |
|||
'((16 0 0 0) |
|||
(16 0 0 0) |
|||
( 4 8 0 0) |
|||
( 4 2 0 0))) |
|||
(check-equal? (moves-grid-left '(( 0 8 8 0) |
|||
(16 0 0 0) |
|||
( 2 2 4 4) |
|||
( 0 2 2 2))) |
|||
'((8 (0 1) (0 0)) |
|||
(8 (0 2) (0 0)) |
|||
(16 (1 0) (1 0)) |
|||
(2 (2 0) (2 0)) |
|||
(2 (2 1) (2 0)) |
|||
(4 (2 2) (2 1)) |
|||
(4 (2 3) (2 1)) |
|||
(2 (3 1) (3 0)) |
|||
(2 (3 2) (3 0)) |
|||
(2 (3 3) (3 1)))) |
|||
(check-equal? (moves-grid-right '(( 0 8 8 0) |
|||
(16 0 0 0) |
|||
( 2 2 4 4) |
|||
( 0 2 2 2))) |
|||
'((8 (0 2) (0 3)) |
|||
(8 (0 1) (0 3)) |
|||
(16 (1 0) (1 3)) |
|||
(4 (2 3) (2 3)) |
|||
(4 (2 2) (2 3)) |
|||
(2 (2 1) (2 2)) |
|||
(2 (2 0) (2 2)) |
|||
(2 (3 3) (3 3)) |
|||
(2 (3 2) (3 3)) |
|||
(2 (3 1) (3 2)))) |
|||
(check-equal? (moves-grid-up '(( 0 8 8 0) |
|||
(16 0 0 0) |
|||
( 2 2 4 4) |
|||
( 0 2 2 2))) |
|||
'((16 (1 0) (0 0)) |
|||
(2 (2 0) (1 0)) |
|||
(8 (0 1) (0 1)) |
|||
(2 (2 1) (1 1)) |
|||
(2 (3 1) (1 1)) |
|||
(8 (0 2) (0 2)) |
|||
(4 (2 2) (1 2)) |
|||
(2 (3 2) (2 2)) |
|||
(4 (2 3) (0 3)) |
|||
(2 (3 3) (1 3)))) |
|||
(check-equal? (moves-grid-down '(( 0 8 8 0) |
|||
(16 0 0 0) |
|||
( 2 2 4 4) |
|||
( 0 2 2 2))) |
|||
'((2 (2 0) (3 0)) |
|||
(16 (1 0) (2 0)) |
|||
(2 (3 1) (3 1)) |
|||
(2 (2 1) (3 1)) |
|||
(8 (0 1) (2 1)) |
|||
(2 (3 2) (3 2)) |
|||
(4 (2 2) (2 2)) |
|||
(8 (0 2) (1 2)) |
|||
(2 (3 3) (3 3)) |
|||
(4 (2 3) (2 3)))) |
|||
(check-equal? (chop '(1 2 3 4 5 6 7 8) 4) |
|||
'((1 2 3 4) (5 6 7 8))) |
|||
(check-equal? (length (initial-state 5)) 25) |
|||
(let* ([initial (initial-state)] |
|||
[initial-sum (apply + initial)] |
|||
[largest-3 (take (sort initial >) 3)]) |
|||
(check-equal? (length initial) 16) |
|||
(check-true (or (= initial-sum 4) |
|||
(= initial-sum 6) |
|||
(= initial-sum 8))) |
|||
(check-true (or (equal? largest-3 '(2 2 0)) |
|||
(equal? largest-3 '(4 2 0)) |
|||
(equal? largest-3 '(4 4 0))))) |
|||
(check-equal? (count-zeros '(1 0 1 0 0 0 1)) 4) |
|||
(check-equal? (count-zeros '(1 1)) 0) |
|||
(check-equal? (replace-nth-zero '(0 0 0 1 2 0) 2 5) |
|||
'(0 0 5 1 2 0)) |
|||
(check-true (finished? '(1 2 3 4) 2)) |
|||
(check-false (finished? '(2 2 3 4) 2))) |
|||
(start) |
|||
</lang> |
</lang> |
||