drive-ya-nuts.rkt

#lang racket/base

; Solution for Drive Ya Nuts game
; http://www.geekyhobbies.com/drive-ya-nuts-puzzle-review-and-solution/
;
; There's almost no skill to the game. It's trial and error. There
; are 7! nut combinations and 6 possible rotations per nut. That
; comes out to 30,240 possible combinations. Ugh.

(require threading
         racket/match
         racket/list)

(module+ test
  (require rackunit))

; These are the configurations for the real nuts from the game
; We started at 1 to make it easier to compare them.
(define nuts
  '((1 6 2 4 5 3)
    (1 6 5 4 3 2)
    (1 4 6 2 3 5)
    (1 2 3 4 5 6)
    (1 6 5 3 2 4)
    (1 4 3 6 5 2)
    (1 6 4 2 5 3)))

; We drew a map to give each nut position a letter and each
; number position on the nut a number. Then figured out which
; coordinates needed to be equal for the board to be a winning board.
;
; Nut positions on the board
;    a
; f     b
; e     c
;    d
;
; Number positions on the nut
;
;    0
; 5     1
; 4     2
;    3
(define (winning-board? board)
  (match board
    [(list (list _ _ a/b a/g _ _)
           (list _ _ _ b/c b/g a/b)
           (list b/c _ _ _ c/d c/g)
           (list d/g c/d _ _ _ d/e)
           (list e/f e/g d/e _ _ _)
           (list _ _ f/g e/f _ _)
           (list a/g b/g c/g d/g e/g f/g)) #t]
    [_ #f]))

(module+ test
  (define winning-board
    '((0 0 1 1 1 0)
      (0 0 0 1 1 1)
      (1 0 0 0 1 1)
      (1 1 0 0 0 1)
      (1 1 1 0 0 0)
      (0 1 1 1 0 0)
      (1 1 1 1 1 1)))
  (check-true (winning-board? winning-board)))

(define (rotate-nut-times lst k)
  (cond [(null? lst) lst]
        [(= k 0) lst]
        [else (rotate-nut-times (append (cdr lst) (list (car lst))) (- k 1))]))

(module+ test
  (define n '(1 2 3 4 5 6))
  (check-equal? (rotate-nut-times n 1) '(2 3 4 5 6 1)))

(define (rotate-nut-to nut num new-idx)
  (define curr-idx (index-of nut num))
  (define rotations
    (cond
      [(> new-idx curr-idx) (+ curr-idx 1 (- 5 new-idx))]
      [(< new-idx curr-idx) (- curr-idx new-idx)]
      [else 0]))
  (rotate-nut-times nut rotations))

(module+ test
  (check-equal? (rotate-nut-to n 4 5) '(5 6 1 2 3 4))
  (check-equal? (rotate-nut-to n 5 1) '(4 5 6 1 2 3))
  (check-equal? (rotate-nut-to n 1 1) '(6 1 2 3 4 5)))

; We use the same matchings for the winning board to rotate
; the nuts to line up. Just because we rotate them doesn't mean
; the board is winning. We still have to check the board after
; we rotate it.
(define (rotate-board board)
  (match-define (list a b c d e f g) board)
  (let* ([a* (rotate-nut-times a 1)]
         [b* (rotate-nut-to b (list-ref a* 2) 5)]
         [c* (rotate-nut-to c (list-ref b* 3) 0)]
         [d* (rotate-nut-to d (list-ref c* 4) 1)]
         [e* (rotate-nut-to e (list-ref d* 5) 2)]
         [f* (rotate-nut-to f (list-ref e* 0) 3)]
         [g* (rotate-nut-to g (list-ref f* 2) 5)])
    (list a* b* c* d* e* f* g*)))

(module+ test
  (check-equal? (rotate-board nuts)
                '((6 2 4 5 3 1)
                  (3 2 1 6 5 4)
                  (6 2 3 5 1 4)
                  (6 1 2 3 4 5)
                  (1 6 5 3 2 4)
                  (6 5 2 1 4 3)
                  (5 3 1 6 4 2))))

(define (find-solutions nuts)
  (~>> (permutations nuts)
       (map get-board-solutions)
       (filter (lambda (n) (not (empty? n))))
       (map first)))

(define (get-board-solutions board)
  (let loop ([b board]
             [solutions '()]
             [rotations 5])
    (cond
      [(= rotations 0) solutions]
      [(winning-board? b) (loop (rotate-board b)
                                (cons b solutions)
                                (sub1 rotations))]
      [else (loop (rotate-board b)
                  solutions
                  (sub1 rotations))])))