(defvar *numbers* '(1 2 5 7))
(defvar *operators* (list '+ '- '* '/))
(defun play-24 (l val)
"Look at all the several thousand permutations of LIST, and print out the ones
whose evaluation is equal to VAL."
(dolist (perm (permute l))
(dolist (group (binary-group perm))
;;(format t "op-permuting and evaluating ~a~%" group)
(dolist (op-perm (op-permute group))
(when (handler-case (= (eval op-perm) val)
(error (condition)
(format t "Skipping ~a: ~a~%" op-perm condition)))
(format t "~d! ~a~%" val op-perm))))))
(defun permute (l)
"Return all possible sequence permutations of list"
(let ((sequences nil))
(if (eql (length l) 2)
;; terminal case of two items: return the list and its reverse
(setq sequences
(list l (reverse l)))
;; recursive case: for each result of eliminating one item from
;; the list, collect the permutations and cons the removed item on
(dotimes (i (length l) sequences)
(let* ((removed (nth i l))
(reduced (remove removed l)))
(dolist (permuted (permute reduced))
(push (cons removed permuted) sequences)))))
(return-from permute sequences)))
;; for now, just hardwire this for the 4 cases
(defun binary-group (l)
"Return all possible binary groupings of LIST, which is assumed to have at least two members.
For example, for the list '(a b c d), the groupings are
'(((a b) c) d)
'((a (b c)) d)
'(a (b (c d)))
'((a b) (c d))
Each list at each level must consist of exactly two items, each either an atom or a list"
(if (= (length l) 4)
(let ((1st (nth 0 l))
(2nd (nth 1 l))
(3rd (nth 2 l))
(4th (nth 3 l)))
(list
(list (list (list 1st 2nd) 3rd) 4th)
(list (list 1st (list 2nd 3rd)) 4th)
(list 1st (list 2nd (list 3rd 4th)))
(list (list 1st 2nd) (list 3rd 4th))
))
(error "Argument must be a list with exactly 4 elements")))
(defun op-permute (l)
"Given LIST, which should be a binary grouping (see binary-group), generate all
possible permutations for the four mathematical operations at each grouping. Since
there are a total of three operation and 4 different operators, that means 4 * 4 * 4 (64)
different operations for a 4-item sequence. Not clear this is general enough for lists
whose length is greater than 4. "
(cond
((terminal-group-p l)
(mapcar #'(lambda (op) (cons op l)) *operators*))
((numberp (first l))
(let ((seq nil))
(dolist (perm (op-permute (second l)))
(dolist (newperm (mapcar #'(lambda (op) (list op (first l) perm)) *operators*))
(push newperm seq)))
seq))
((numberp (second l))
(let ((seq nil))
(dolist (perm (op-permute (first l)))
(dolist (newperm (mapcar #'(lambda (op) (list op perm (second l))) *operators*))
(push newperm seq)))
seq))
;; otherwise both must be lists
((and (listp (first l))
(listp (second l)))
(let ((seq nil)
(l1 (mapcar
#'(lambda (op) (cons op (first l)))
*operators*))
(l2 (mapcar
#'(lambda (op) (cons op (second l)))
*operators*)))
(dolist (l1 (mapcar
#'(lambda (op) (cons op (first l)))
*operators*))
(dolist (l2 (mapcar
#'(lambda (op) (cons op (second l)))
*operators*))
(mapcar
#'(lambda (op) (list op l1 l2))
*operators*)))))
(t 'uh-oh)))
(defun terminal-group-p (list)
"True if LIST is a list of two symbols, otherwise false. "
(and (listp list)
(numberp (first list))
(numberp (second list))))