almost complete 2048 implemtation... can only shift tiles one direction (left), but compensates for that by rotating the grid before and after shifting.

2048

#lang racket

(require rackunit)
(require racket/list)

(define board (list (list 0 0 0 0)
                    (list 0 2 0 0)
                    (list 0 0 0 0)
                    (list 0 0 0 2)))

(define (makeRowFromCol rows n)
  (cond [(empty? rows)
         empty]
        [else
         (cons (list-ref (first rows) n)
               (makeRowFromCol (rest rows) n))]))
(check-equal? (makeRowFromCol board 0)
              '(0 0 0 0))
(check-equal? (makeRowFromCol board 1)
              '(0 2 0 0))

(define (rotate grid)
  (list (makeRowFromCol grid 3)
        (makeRowFromCol grid 2)
        (makeRowFromCol grid 1)
        (makeRowFromCol grid 0)))

(check-equal? (rotate (list (list 1 2 3 4)
                           (list 0 0 2 0)
                           (list 0 0 0 0)
                           (list 0 0 0 0)))
              (list (list 4 0 0 0)
                    (list 3 2 0 0)
                    (list 2 0 0 0)
                    (list 1 0 0 0)))

(define (shiftAllLeft rows)
  (cond [(empty? rows)
         empty]
        [else
         (cons (shiftRowLeft (first rows))
               (shiftAllLeft (rest rows)))]))

(define (shiftRowLeft row)
  (padEndWithZeros (mergeTiles (filter positive? row)) 4))

(define (mergeTiles tiles)
  (cond [(empty? tiles)
         empty]
        [(empty? (rest tiles))
         tiles]
        [(equal? (first tiles) (first (rest tiles)))
         (cons (* 2 (first tiles)) 
               (mergeTiles (rest (rest tiles))))]
        [else
         (cons (first tiles)
               (mergeTiles (rest tiles)))]))

(check-equal? (mergeTiles (list 2 2 2 2))
              (list 4 4))
(check-equal? (mergeTiles (list 4 4 2))
              (list 8 2))

(define (padEndWithZeros ls length)
  (cond [(zero? length)
         empty]
        [(empty? ls)
         (cons 0 (padEndWithZeros empty (sub1 length)))]
        [else
         (cons (first ls)
               (padEndWithZeros (rest ls) (sub1 length)))]))

(check-equal? (padEndWithZeros empty 4)
              (list 0 0 0 0))
(check-equal? (padEndWithZeros (list 1 4 6) 4)
              (list 1 4 6 0))

(define (coutnEmpty board)
  (count zero? (flatten board)))

(define (slideLeft grid)
  (shiftAllLeft grid))
(define (slideRight grid)
  (rotate (rotate (shiftAllLeft (rotate (rotate grid))))))
(define (slideDown grid)
  (rotate (shiftAllLeft (rotate (rotate (rotate grid))))))
(define (slideUp grid)
  (rotate (rotate (rotate (shiftAllLeft (rotate grid))))))

(check-equal? (slideLeft (list (list 0 0 0 0)
                               (list 2 0 2 0)
                               (list 0 0 2 0)
                               (list 0 2 4 4)))
              (list (list 0 0 0 0)
                    (list 4 0 0 0)
                    (list 2 0 0 0)
                    (list 2 8 0 0)))

(check-equal? (slideRight (list (list 0 0 0 0)
                                (list 2 0 2 0)
                                (list 0 0 2 0)
                                (list 0 2 4 4)))
              (list (list 0 0 0 0)
                    (list 0 0 0 4)
                    (list 0 0 0 2)
                    (list 0 0 2 8)))

(check-equal? (slideUp (list (list 0 0 0 0)
                             (list 2 0 2 0)
                             (list 0 0 2 0)
                             (list 0 2 4 4)))
              (list (list 2 2 4 4)
                    (list 0 0 4 0)
                    (list 0 0 0 0)
                    (list 0 0 0 0)))

(check-equal? (slideDown (list (list 0 0 0 0)
                               (list 2 0 2 0)
                               (list 0 0 2 0)
                               (list 0 2 4 4)))
              (list (list 0 0 0 0)
                    (list 0 0 0 0)
                    (list 0 0 4 0)
                    (list 2 2 4 4)))