Skip to content

Instantly share code, notes, and snippets.

@smizell
Last active Aug 14, 2021
Embed
What would you like to do?
#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))])))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment