;
; Number Countdown
; from Lisp in Small Parts, http://lisp.plasticki.com/
; Licensed under CC0 1.0: http://creativecommons.org/publicdomain/zero/1.0/
; 30th June 2012
;

; This may be necessary on some versions of LispWorks to avoid a stack overflow
(proclaim '(optimize (debug 2)))

(defparameter countdown-numbers '(75 100 50 25 1 4))

(defparameter countdown-operators '(?+ ?- ?* ?/))

(defparameter countdown-target 887)

(defun find-tree (number expression)
  (if (atom expression) (eq number expression)
      (or (find-tree number (first expression))
          (find-tree number (rest expression)))))

(defun ?+ (a b)
  (if (or (null a) (null b) (< a b) (zerop a))
      nil
    (+ a b)))

(defun ?- (a b)
  (if (or (null a) (null b) (zerop b) (< a b))
      nil
    (- a b)))

(defun ?* (a b)
  (if (or (null a) (null b) (< a b) (= b 1) (= a 1) (= b 0) (= a 0))
      nil
    (* a b)))

(defun ?/ (a b)
  (if (or (null a) (null b) (zerop b) (= b 1) (not (integerp (/ a b))))
      nil
    (/ a b)))

(defun next-states (expression)
  (let ((result nil))
    (dolist (i countdown-numbers)
      (if (find-tree i expression) nil
        (setf result (cons (cons i expression) result))))
    (if (>= (length expression) 2)
        (dolist (i countdown-operators)
          (let ((new (list i (first expression) (second expression))))
              (if (eval new)
                  (setf result
                        (cons (cons new (rest (rest expression))) result))))))
    result))

(defun tree-search (expressions)
  (cond
   ((null expressions) nil)
   ((goal-p (first expressions)) (first expressions))
   (t (tree-search
       (append
        (next-states (first expressions))
        (rest expressions))))))

(defun goal-p (rule)
  (and (= (length rule) 1)
       (eq (eval (first rule)) countdown-target)))