general backtracking algorithm in Lisp

Hi,

I am new to Common Lisp and looking for a CL implementation of the backtracking algorithm described in here: http://en.wikipedia.org/wiki/Backtracking

Can someone help me?

I do not believe so. The generic algorithm is so trivial that is would be much easier to implement a version specialized for the given problem rather the to deal with an abstracted version. If implementing such is not easy for you, then perhaps you should study a basic CL text like Practical Common Lisp or Gentle Introduction to Symbolic Computation. PAIP would be directly applicable, but unfortunately it is not available online for free.

You may be interested in Screamer and the recent blog posts by Nikodemus. post 1 Einstein Zebras

Thanks.

I *do* own PAIP. Which chapter should I look at?

imba wrote:I *do* own PAIP. Which chapter should I look at?

There is an index. Chapter 11 describes backtracking as related to logic programming.

Also, why do you need that? I interpreted the question as likely homework related. If that is homework related, then either an implementation would be provided, or the intent was to implement backtracking yourself. Usually backtracking is applied to something, and for many application a fairly simple implementation is sufficient. A fully generic system like Screamer, which I did not think about, is fairly complex. If you want to implement your own system then it would probably be better to start from scratch. I you only want to use it, the Screamer is fine. I see that it has been somewhat modernized since the last time I looked at it, when it included its own version of iterate...

Heres a real simple implementation. Given A in the range of 0 32, B in the range of 0 64, and C in the range of 0 128, it collects every combination of these 3 values that solves =128. Currently =128 is set to (= 128 (+ (* a b) c)), but could be changed.

(defmacro awhen (clause &rest body) `(let ((it ,clause)) (when it ,@body)))

(defvar *fail-stack*)
(defvar *results*)

(defun evaluate () (setf *results* nil) (tagbody :start (awhen (pop *fail-stack*) (funcall it) (go :start))) *results*)

(defun apply-one-of (k start length)
  (assert (>= length 0))
  (if (zerop length)
      (funcall k start)
      (progn (push #'(lambda () (apply-one-of k start (1- length))) *fail-stack*)
	     (funcall k (+ start (1- length))))))

(defun =128? (a b c) (= 128 (+ (* a b) c)))

(setf *fail-stack*
      (list #'(lambda () (apply-one-of
		     #'(lambda (a) (apply-one-of
			       #'(lambda (b) (apply-one-of
					 #'(lambda (c) (when (=128? a b c) (push (list a b c) *results*)))
					 0 128))
			       0 64))
		     0 32))))
(evaluate)

This particular problem could be more easily solved with straight forward loops, but it illustrates how backtracking is implemented. Basically, you have this fail stack of functions to execute. Take the top one and run it. It could potentially put more fail functions on the fail-stack.

The next trick is generating the functions. Generally you want functions that continue from where you currently are, but with a different value. This is where continuations come in. I've written my 'apply-one-of' in a continuation-passing style, but you could use macros to assist the conversion. This example was so simple I could name my continuations like so, most backtracking computations are not so simple.

(defun step-c (c) (when (=128? *a* *b* c) (push (list *a* *b* c) *results*)))
(defun step-b (b) (setf *b* b) (apply-one-of #'step-c 0 128))
(defun step-a (a) (setf *a* a) (apply-one-of #'step-b 0 64))
(defun solve () (apply-one-of #'step-a 0 32))

(setf *fail-stack* (list #'solve))
(evaluate)

Thank you very much, Warren, I'll try this out!

How do I have to modify this source code so that
a) every continuation is valuated and discarded if the valuation is too low
b) there is an evaluation of the whole sequence at the end.
c) the valuations of each step are remembered

(C++-Code:

	void backtrack(T& sequence, int cumulated_valuation)
	{
		if (sequence == max)
		{
			if (valuation >= threshold)
			{
				if (final_valuation(stimme) >= threshold_end)
				{
						output(sequence);
					}
					++found_completions;
			}

			return;
		}

		continuations = generate_continuations(sequence); // Continuations together with their valuation

		for (auto continuation = continuations.begin(); continuation !=continuations.end(); ++continuations)
		{
			sequence.push_back(continuation ->first); // takt setzt Stimme zulässig fort

			backtrack(sequence,  cumulated_valuation + continuation->second);

			sequence.pop_back();
		}
	}

Backtracking in C (or C++) is significantly harder than it would be in Lisp, so even if you know C++ writing requirements in it might influences your thoughts.

I'm not entirely sure what you mean by valuations. I'm going to restate what I think your asking and you can tell me if I've missed the mark:

• every continuation is valuated and discarded if the valuation is too low

  I'm going to assume you mean something like 'When I know that my input variables will not lead to a solution, how can I immediately move onto the next candidate (aka, how do I backtrack to my last good state?)'
  
  The code I've given is basically tail recursive. Any step can add functions to *fail-stack* (which is a global variable) and, by convention, the last step pushes one result onto results. If a function terminates without modifying *results*, that is largely the same as if it had never run at all (however, it could have other side effects if you wrote it that way).
  
  Once the function terminates, regardless of whether it touched *results*, the next function of *fail-stack* is called by (evaluate), which just keeps on churning away until theres nothing left.
  
  My code just generates functions that try every number within a range. You could have a more sophisticated function that only produced the odd numbers, or only produced strings of a certain pattern, etc. You need to fail values you never try.

• there is an evaluation of the whole sequence at the end.

  I've taken this to mean: "How do I produce a list of EVERY possible solution". The code I've given returns a list of every possible solution (so long as there are a finite number of possible solutions), you can then process that as a List.

• the valuations of each step are remembered

  I've taken this to mean "How can I determine how a particular solution was generation (what path did my code take in generating this solution)". This is tricky and I doubt it's what you're really asking, so I'm not going to answer it =).

Warren Wilkinson wrote:Backtracking in C (or C++) is significantly harder than it would be in Lisp, so even if you know C++ writing requirements in it might influences your thoughts.

I'm not entirely sure what you mean by valuations.

I mean that every continuation is assigned a valuation to, and if this valuation is < threshold, all children of this node are skipped. (Yes, I am porting a C++ program to Common Lisp and have no experience with Lisp.)

ad 1): "I'm going to assume you mean something like 'When I know that my input variables will not lead to a solution, how can I immediately move onto the next candidate (aka, how do I backtrack to my last good state?)'" Yes, this is what I meant. I don't understand your code fully. I mean something like that: Assume a solution must fulfill "a * b * c = 21". Then if our program sees that (evenp b), it should make a short cut here and go back to a. But there might also be a condition that depends not solely on b, but also on a, so the whole partial solution "a b" should be considered. (e.g. "a and b have no common prime factor")

ad 2): OK.

ad 3): I simply want to save the valuation of each node in the tree.

I hope I made my points clearer.

Your points are clearer, it sounds like you want to apply a heuristic throughout the search --- is this by any chance a MIN/MAX algorithm for a game?

Given your requirements, I would recommend against backtracking the way I've already layed out. The way I've explained it keeps everything on the stack, and so backtracks without extra data structures, which is very generic. A different approach is to search by maintaining a collection of in-memory states, a function to compute the possible next states from a given state, and a heuristic function that tells us if a given state is likely to go anywhere.

A user in another post (viewtopic.php?f=2&t=868&start=0) asked about how he could implement a board AI for a simple tic-tac-toe game. I gave him this code to illustrate how a simple search goes. You might find that discussion relevant.

(defpackage :tictac
  (:use :common-lisp))

(in-package :tictac)

;; Using a vector to represent the board makes access
;; easier and faster e.g. (elt *board* (+ (* 3 x) y))
(defun make-board () (make-array 9 :initial-element nil))
(defun empty-board-p (board) (every #'null board))

;; +search-depth+ controls recursion depth.
(defconstant +search-depth+ 4)

;; Gen-next takes a current board position, and must generate
;; all valid positions that can be made from it. Because its
;; NIL, the game will assume there are never any valid
;; positions, and will be over very soon.
(defun gen-next (board our-turn-p) (declare (ignore board our-turn-p)) nil)

;; A board-score of 0 is neutral. Use negative numbers to communicate
;; a board is BAD, and positive to communicate a board is good.
(defun board-score (board) (declare (ignore board)) 0)
;; Score calculates the boards score then adds the score for the
;;  boards children (upto +search-depth+ deep)  to produce the
;; branches total score.
(defun score (board depth)
  (let ((score (board-score board)))
    (if (= depth +search-depth+)
	score
	(loop for child in (gen-next board (evenp depth)) ;; Even-p means its our move, odd means theirs.
	      do (incf score (score child (1- depth)))
	      finally (return score)))))

;; Choose computes the children for a board and runs SCORE on each
;; one. It returns the board with the highest score, or NIL if
;; there where no boards.
(defun choose (board)
  (caar (sort (loop for child in (gen-next board t) collecting (cons child (score child 0))) #'> :key #'cdr)))
  	
;; AI will return the next board or NIL if the game is over.
(defun ai (board) (format t "~%I'm thinking...") (choose board))

The function CHOOSE arranges all the possible next states by their score and takes the best one, which is generally what you want. With slighly different code, you could display the next-states to the user and let him pick one.

I implemented it as follows:

(backtrack foo ...
  (if (foo
      (when (bar
          (baz))
    (loop for continuation in (create-continuations)
          as Continuation = (backtrack ))
          collecting Continuation)))

But I only want to collect those Continuations which aren't NIL. How do I implement this (without removing NIL only at the end).

EDIT: I found it out: just add a "when (not (null Cont.)))".