LispForum

Posted: **Sun Nov 21, 2010 2:57 pm**

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?

Posted: **Sun Nov 21, 2010 3:12 pm**

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.

Posted: **Sun Nov 21, 2010 6:57 pm**

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

Posted: **Mon Nov 22, 2010 4:12 am**

Thanks.

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

Posted: **Mon Nov 22, 2010 6:20 am**

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...

Posted: **Mon Nov 22, 2010 11:43 am**

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.

Code: Select all

(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.

Code: Select all

(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)

Posted: **Mon Nov 22, 2010 12:08 pm**

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

Posted: **Mon Nov 22, 2010 12:58 pm**

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:

Code: Select all

	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();
		}
	}

Posted: **Mon Nov 22, 2010 3:23 pm**

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 =).

Posted: **Mon Nov 22, 2010 3:57 pm**

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.

LispForum

general backtracking algorithm in Lisp

general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp

Re: general backtracking algorithm in Lisp