;;;; -*- mode:Scheme -*- ;;;;

(define (backtrack-fc-dynamic pick-next-variable sort-values)
  ;; this function does all the work.
  (define (backtrack-fc-dynamic-aux var var-values done-vars)
    ;; called when a tentative assignment fails.
    (define (fail saved-domains)
      (if *verbose* 
	  (format #t "Failing for var = ~a value = ~a~%"
		  var (first var-values)))
      ;; could not extend to next variable, undo side effects
      (restore-domains saved-domains)
      ;; try again with a new value for var
      (backtrack-fc-dynamic-aux var (rest var-values) done-vars))

    (if (null? var-values)		; if we have a var but no values
	#f				; we are inconsistent
      (let ((domains (list-domains)))
	;; pick one value
	(set-var-domain! var (list (first var-values)))
	(format #t "~s <- ~s ~a~%" (name-of var) (first var-values) *number-of-arc-tests*)
	;; propagate the constraints on the arcs affected by our
	;; choice of a fixed value for var.
	(if (forward-check var)
	    (let ((new-var (pick-next-variable var done-vars)))
	      (if new-var
		  ;; try extending to another variable, else fail.
		  (or (backtrack-fc-dynamic-aux
		       new-var (sort-values new-var) (cons new-var done-vars))
		      (fail domains))
		  ;; If var is #f, this means that all the variables have unique
		  ;; values, so we're done
		(map car (list-domains))
		))
	  (fail domains)))))
  ;; Start backtracking with the first variable.
  (let ((var (pick-next-variable #f '())))
    (if var				; make sure we have at least one var.
	(backtrack-fc-dynamic-aux var (sort-values var) (list var))))
  )

;;; Returns #f if no variable is ambiguous (we are done!).  Otherwise,
;;; returns index of variable with either an empty domain (we failed!)
;;; or one with least entries in domain (which means the search
;;; will need to continue).
(define (pick-most-constrained cur-var done-vars)
  (let ((best-val 10000.)
	(best-var #f))
    (define (pick-loop i)
      (if (>= i *number-of-variables*) 
	  best-var
	  (let ((domain (domain-of i)))
	    (if (null? domain)
		(set! best-var i)
		(let ((length (length domain)))
		  (if (not (member i done-vars))
		      (if (< length best-val)
			  (begin
			    (set! best-val length)
			    (set! best-var i))))
		  (pick-loop (+ 1 i))
		  )))))
    (pick-loop 0)
    best-var))

;;; The opposite of above.
(define (pick-least-constrained cur-var done-vars)
  (let ((most-val 0.)
	(most-var #f))
    (define (pick-loop i)
      (if (>= i *number-of-variables*) 
	  most-var
	  (let ((domain (domain-of i)))
	    (if (null? domain)
		(set! most-var i)
		(let ((length (length domain)))
		  (if (not (member i done-vars))
		      (if (> length most-val)
			  (begin
			    (set! most-val length)
			    (set! most-var i))))
		  (pick-loop (+ 1 i))
		  )))))
    (pick-loop 0)
    most-var))

;;; Simply increment cur-var, unelss we are at the last var, in which
;;; case, return #f.  If cur-var = #f, then return 0 (the first var
;;; index).

(define (pick-next cur-var done-vars)
  (if cur-var
      (if (= cur-var (- *number-of-variables* 1)) 
	  #f 
	  (+ 1 cur-var)) 
      0))

;;; Sort the values in the domain of var by how many deletions in
;;; "adjacent" variables would result from setting var to that value.

(define (sort-least-constrained-values-first var)
  (let ((values (domain-of var)))
    ;; throw away the car, keep only the actual domain values after
    ;; sorting.
    (map cdr
	 ;; sort by least number of deletions, i.e. leaves most
	 ;; options open for the future.
	 (sort
	  ;; construct pairs of (n-deletions . value)
	  (map (lambda (val)
		 (cons (count-forward-check-deletions var val)
		       val))
	       values)
	  ;; comparison function based on the car of pair (n-deletions).
	  (lambda (x y) (< (car x) (car y)))))))