Backtracking with heuristic solution in scheme to https://leosstemhacks.wordpress.com/2018/03/27/np-complete-3rd-grade-math-problems/

grade3_amesment_store_sat_backtracking.scm

;;; https://leosstemhacks.wordpress.com/2018/03/27/np-complete-3rd-grade-math-problems/
;;; https://news.ycombinator.com/item?id=28343073
;;;
;;; I frame this as a satisfiability problem and tackle it with backtracking
;;; and an optimizing heuristic
;;;
;;; The heuristic is this, we sort the items from lowest value to greatest
;;; and only try to add the next lowest item available in our search
;;; if that item puts the total over, then we know all remaining items
;;; which are of greater value will do the same
;;;
;;; Theoretically, this heuristic may not save much work at all if the problem
;;; is bad enough.
;;; In practice, with this sample input, this optimizing heuristic works
;;; great! Without the heuristic, 2 to the power to 20 (1 million)
;;; possibilities must be looked at.
;;;
;;; But, a trace showed this heuristic reduced the search to just over a
;;; thousand possibilities that needed to be looked at before finding
;;; a solution. That's a 1000x improvement!
(define
  PROBLEM_ITEMS
  '( (122 . "yo yo")     ; $1.22
     (275 . "doll")      ; $2.75
     (185 . "duckie")    ; $1.85
     (597 . "tractor")   ; $5.97
     (649 . "airplane")  ; $6.49
     (216 . "ball")      ; $2.16
     (713 . "racecar")   ; $7.13
     (457 . "dog")       ; $4.57
     (146 . "jump rope") ; $1.46
     (518 . "car")       ; $5.18
     (316 . "elephant")  ; $3.16
     (489 . "bear")      ; $4.89
     (711 . "xylophone") ; $7.11
     (645 . "tank")      ; $6.45
     (477 . "checkers")  ; $4.77
     (804 . "boat")      ; $8.04
     (671 . "train")     ; $6.71
     (231 . "jacks")     ; $2.31
     (98  . "whistle")   ; $0.98
     (87  . "pinwheel")  ; $0.87
     ))

(define PROBLEM_TARGET 4394) ; $43.94

(define (problem_item_compare y x)
  (< (car y) (car x)))

(define PROBLEM_ITEMS_SORTED (sort PROBLEM_ITEMS problem_item_compare))

(define (recursive_backtrack sumsofar remainitems itemssofar)
  ;; first look for the terminal cases, having found the solution
  ;; (which we back-propagate) as success
  ;; or having run out of items, which we back-propagate with empty list
  ;; '() aka null as failure
  (cond ( (= sumsofar PROBLEM_TARGET) itemssofar)
        ( (null? remainitems) '() )
        ;; otherwise, try including the next item or not
        (else
         (let ( (newsum (+ sumsofar (car (car remainitems))) ))
           ;; if including the latest item doesn't put us over
           ;; we check if including it and possibly others works
           ;; note < and = checked because we'll hit the success cond defined
           ;; at the top if we have a match (=)
           (if (<= newsum PROBLEM_TARGET)
               ;; if the next item doesn't put us over
               ;; recursively see how that works out
               (let ( (recursionifincluded
                    (recursive_backtrack newsum
                                            (cdr remainitems)
                                            (cons (car remainitems)
                                                  itemssofar))) )
                 (if (null? recursionifincluded)
                     ;; if including the next item failed,
                     ;; recursively try one of the others after it
                     (recursive_backtrack sumsofar
                                          (cdr remainitems)
                                          itemssofar)
                     ;; otherwise, we found a solution, back-propagate it!
                     recursionifincluded))

               ;; this is the optimization heuristic, if including
               ;; the next item puts us over the target,
               ;; e.g. (> newsum PROBLEM_TARGET)
               ;; then we know all of the remaining next items will do so
               ;; as well due to the sort, so we bail out for back-tracking
               ;; nice and early
               '()
               )))))

(display (recursive_backtrack 0 PROBLEM_ITEMS_SORTED '()))
(newline)