63 lines
2.1 KiB
Common Lisp
63 lines
2.1 KiB
Common Lisp
;;; Approach: Try all permutations for 4 digits (1 - 9) and try all
|
|
;;; permutations of arithmetic operators, using both possible
|
|
;;; three-operator computation trees.
|
|
|
|
(defparameter *arithmetic-operations* (list #'+
|
|
#'-
|
|
#'*
|
|
#'/))
|
|
|
|
(defun possible-results (digits)
|
|
"Returns all the possible arithmetic results from the digits in the ascending list LIST"
|
|
(ret (results nil)
|
|
(for-each-permutation
|
|
(lambda (list)
|
|
(loop for op1 in *arithmetic-operations* do
|
|
(loop for op2 in *arithmetic-operations* do
|
|
(loop for op3 in *arithmetic-operations* do
|
|
;; Note: There are only two tree structures; test them both
|
|
(let ((values nil))
|
|
;; E.g. (1 + 2) * (3 + 4)
|
|
(ignore-errors
|
|
(let* ((a (funcall op1 (first list) (second list)))
|
|
(b (funcall op2 (third list) (fourth list)))
|
|
(result (funcall op3 a b)))
|
|
(pushnew result values)))
|
|
;; E.g. (1 + 2) * 3 / 4
|
|
(ignore-errors
|
|
(let ((result (first list)))
|
|
(setf result (funcall op1 result (second list)))
|
|
(setf result (funcall op2 result (third list)))
|
|
(setf result (funcall op3 result (fourth list)))
|
|
(pushnew result values)))
|
|
;; Add valid results
|
|
(loop for result in values do
|
|
(when (and (integerp result)
|
|
(>= result 1))
|
|
(pushnew result results))))))))
|
|
digits)))
|
|
|
|
(defun consecutive (values)
|
|
"Returns the number of consecutive positive integers from 1 that are in VALUES"
|
|
(loop for count upfrom 0
|
|
for last-value = 0 then value
|
|
for value in values
|
|
while (= (1+ last-value) value)
|
|
finally (return count)))
|
|
|
|
(defun arithmetic-expressions ()
|
|
(loop with best = 0
|
|
with best-list = nil
|
|
for a from 1 upto 6
|
|
do (loop for b from (1+ a) upto 7 do
|
|
(loop for c from (1+ b) upto 8 do
|
|
(loop for d from (1+ c) upto 9
|
|
for list = (list a b c d)
|
|
for possible = (possible-results list)
|
|
for consecutive = (consecutive (sort possible #'<))
|
|
do (when (> consecutive best)
|
|
(setf best consecutive)
|
|
(setf best-list list)))))
|
|
finally (return (values (concatenate 'string (mapcar #'digit-char best-list))
|
|
best))))
|