55 lines
1.7 KiB
Common Lisp
55 lines
1.7 KiB
Common Lisp
(defparameter *two-digit-squares* (loop for n upfrom 1
|
|
for square = (* n n)
|
|
while (<= square 99)
|
|
collect square))
|
|
|
|
(defparameter *two-digit-pairs*
|
|
(loop for square in *two-digit-squares*
|
|
collect (list (if (<= square 9)
|
|
0
|
|
(floor square 10))
|
|
(mod square 10))))
|
|
|
|
(defun subsets (set count)
|
|
"Returns a list of all subsets of SET of size COUNT"
|
|
(ret (subsets nil)
|
|
(labels ((recurse (set count tail)
|
|
(cond ((= count 0) (push tail subsets))
|
|
(t (loop for (item . rest) on set
|
|
do (recurse rest (1- count) (cons item tail)))))))
|
|
(recurse set count nil))))
|
|
|
|
(defun valid-digit-p (digit set)
|
|
"Returns non-NIL if DIGIT is in SET, with the special rule that 6 matches 9 and vice versa"
|
|
(if (or (= digit 9) (= digit 6))
|
|
(or (member 9 set) (member 6 set))
|
|
(member digit set)))
|
|
|
|
(defun solutionp (cube1 cube2)
|
|
"Returns non-NIL if CUBE1 and CUBE2 can make all squares"
|
|
(loop for (a b) in *two-digit-pairs*
|
|
do (unless (or (and (valid-digit-p a cube1)
|
|
(valid-digit-p b cube2))
|
|
(and (valid-digit-p a cube2)
|
|
(valid-digit-p b cube1)))
|
|
(return nil))
|
|
finally (return t)))
|
|
|
|
(defun cube-digit-pairs ()
|
|
(let* ((digits (loop for n from 0 upto 9 collect n))
|
|
(cubes (subsets digits 6))
|
|
(solutions (make-hash-table :test 'equal))
|
|
(solution-count 0))
|
|
(loop for cube1 in cubes do
|
|
(loop for cube2 in cubes
|
|
do (when (solutionp cube1 cube2)
|
|
;; Check for *both* orderings of cubes
|
|
(let ((a (append cube1 cube2))
|
|
(b (append cube2 cube1)))
|
|
(unless (or (gethash a solutions)
|
|
(gethash b solutions))
|
|
(incf solution-count)
|
|
(setf (gethash a solutions) t)
|
|
(setf (gethash b solutions) t))))))
|
|
solution-count))
|