Reputation: 768
The "finding the digits problem" is this:
Find unique decimal digits A, B, C such that
CCC
+ BBB
+ AAA
= CAAB
To solve it using recursion in Common Lisp, I've written this code:
(defun find! ()
(found? 0 ;; initially point to the number 1
'(1 2 3) ;; initial list
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion happens here
lst
(setf occupied (remove j occupied)))))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar
(lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst)
(first lst) (second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
The delivered result (lst
) is (9 9 9)
The expected result (lst
) is (9 8 1)
meaning A=9
, B=8
, C=1
so that the equation CCC + BBB + AAA = CAAB
holds i.e.
111 ; CCC
+ 888 ; BBB
+ 999 ; AAA
= 1998 ; CAAB
Which parts of the code should I change so that it gives the expected result? Can someone fix the code? Note that using recursion is a must. Only one line of recursion is enough i.e. like the line where the ;; recursion happens here
comment is.
What is the minimal edit to fix this code?
Upvotes: 0
Views: 298
Reputation: 71065
The minimal edit needed to make your code work is the following three small changes (marked with ;;;; NB
in the comments):
(defun find! ()
(found? 0 ;; initially point to the number 1
(list 1 2 3) ;; initial list ;;;; NB freshly allocated!
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
push
of j
into occupied
:(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion happens here
lst) ;;;; NB
(setf occupied (remove j occupied)))) ;;;; NB _always_ undo the push
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar
(lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst)
(first lst) (second lst))))))
(if (= lefthnd rghthnd)
(return-from found? lst) ;;;; NB actually return here
'nil))))))
If you change the return-from
line to print the result instead of returning it, you will get all of them printed.
If you want to get them all in a list instead of being printed, you can surgically append each of the results to some list defined in some outer scope (or cons
onto the front and reverse it when it's all done, if you prefer).
Or in general, you can change this code to accept a callback and call it with each result, when it is found, and let this callback to do whatever it does with it -- print it, append it to an external list, whatever.
Remarks: your code follows a general recursive-backtracking approach, creating three nested loops structure through recursion. The actual result is calculated -- and put into lst
by surgical manipulation -- at the deepest level of recursion, corresponding to the innermost loop of j
from 1
to 9
(while avoiding the duplicates).
There's lots of inconsequential code here. For instance, the if
in (if (found? ...) lst)
isn't needed at all and can be just replaced with (found? ...)
. I would also prefer different names -- occupied
should really be named used
, lst
should be res
(for "result"), index
is canonically named just i
, width
is just n
, etc. etc. (naming is important)... But you did request the smallest change.
This code calculates the result lst
gradually, as a side effect on the way in to the innermost level of the nested loops, where it is finally fully set up.
Thus this code follows e.g. an example of Peter Norvig's PAIP Prolog interpreter, which follows the same paradigm. In pseudocode:
let used = []
for a from 1 to 9:
if a not in used:
used += [a]
for b from 1 to 9:
if b not in used:
used += [b]
for c from 1 to 9:
if c not in used and valid(a,b,c):
return [a,b,c] # or:
# print [a,b,c] # or:
# call(callback,[a,b,c]) # etc.
remove b from used
remove a from used
Here's your code re-structured, renamed, and streamlined:
(defun find2 ( &aux (res (list 0 0 0))
(used '()) (n (length res)))
(labels
((f (i)
(do ((d 1 (1+ d))) ; for d from 1 to 9...
((> d 9) 'FAIL) ; FAIL: no solution!
(unless (member d used) ; "d" for "digit"
(setf (nth i res) d) ; res = [A... B... C...]
(cond
((< i (- n 1)) ; outer levels
(setf used (cons d used))
(f (1+ i)) ; recursion! going in...
(setf used (cdr used))) ; and we're out.
(T ; the innermost level!
(let ((left (* 111 (reduce #'+ res)))
(rght (reduce #'+
(mapcar #'* '(1000 100 10 1)
(list (third res) ; C A A B
(first res)
(first res)
(second res))))))
(if (= left rght)
(return-from find2 res))))))))) ; success!
(f 0)))
This is now closely resembling the C++ code you once had in your question, where the working function (here, f
) also received just one argument, indicating the depth level of the nested loop -- corresponding to the index of the digit being tried, -- and the rest of the variables were in an outer scope (there, global; here, the auxiliary variables in the containing function find2
).
By the way, you aren't trying any 0
s for some reason.
Upvotes: 3
Reputation: 51501
Your code
(defun find! ()
(found? 0 ;; initially show the number 1
'(1 2 3) ;; initial list
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion
lst
(setf occupied (remove j occupied)))))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+ (mapcar (lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst) (first lst) (second lst))
))))
(if (= lefthnd rghthnd)
lst
'nil))))))
Indentation and comment style: end-of-line comments use a single semicolon, align non-body arguments, indent bodies by two spaces
(defun find! ()
(found? 0 ; initially show the number 1
'(1 2 3) ; initial list
'() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
lst
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar (lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
Use more telling predicates: find or member. Don't wrap * in a lambda doing nothing else. (I'll leave aside find! hereafter.)
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
lst
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
The body of a do
doesn't return anything. There is a lot of dead code,
which we remove now:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(unless (found? (1+ index) lst occupied width) ; recursion
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)))))
Instead of pushing and then conditionally removing, we can conditionally push:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (found? (1+ index) lst occupied width) ; recursion
(push j occupied))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)))))
While it makes a difference in performance, putting the outer conditional into the inner body makes it more readable here:
(defun found? (index lst occupied width)
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (and (< index (1- width))
(found? (1+ index) lst occupied width)) ; recursion
(push j occupied)))))
This does nothing except count to 9 a few times, which seems to be congruent to your findings.
I guess that you wanted to return something from the dead code. You might
want to use return-from
for that.
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
(return-from found? lst)
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
This returns (1 2 9), which is wrong. The problem seems to be that you return the list even when you run over 9, but you want to return nil then, because you didn't find anything.
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) nil) ; <- nothing found
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
(return-from found? lst)
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) nil) ; <- nothing found
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
This returns (9 8 1), which is correct. Now that I seem to understand what you're trying to do, let's refactor a bit more. Instead of pushing and removing from the occupied list, just create a new list with the new element in front transiently:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) nil)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst))))
(do ((j 1 (1+ j)))
((> j 9) nil)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
I think that using loop instead of do makes this much more readable:
(defun found? (index lst occupied width)
(if (< index (1- width))
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst)))
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst))))))
Since the loop is rather elaborate, I'd want to write and read it only once, so move the outer condition inside:
(defun found? (index lst occupied width)
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(if (< index (1- width))
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst))
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst))))))
Did you see that occupied is just the first one or two elements of lst, reversed? Instead of setting list elements, we can build up lst through the recursion. We actually need to return the recursive results for that, so this is better referential transparency.
(defun find! ()
(found? 0 ; initially show the number 1
'() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (index part width)
(loop :for j :from 1 :to 9
:unless (find j part :test #'=)
:do (if (< index (1- width))
(let ((solution (found? (1+ index) ; recursion
(cons j part)
width)))
(when solution
(return-from found? solution)))
(let* ((full (cons j part))
(lefthnd (* 111 (reduce #'+ full)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third full)
(first full)
(first full)
(second full))))))
(when (= lefthnd rghthnd)
(return-from found? full))))))
Index and width are now only used for counting, so we only need one number, which we can count towards zero. This also makes apparent that we should probably move the base case out of the looping:
(defun find! ()
(found? '() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (part count)
(if (zerop count)
(let* ((full part) ; just rename to show that the number is complete
(lefthnd (* 111 (reduce #'+ full)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third full)
(first full)
(first full)
(second full))))))
(when (= lefthnd rghthnd)
(return-from found? full)))
(loop :for j :from 1 :to 9
:unless (find j part :test #'=)
:do (let ((solution (found? (cons j part)
(1- count))))
(when solution
(return-from found? solution))))))
I think this more or less is what you can do if you keep it to a single
function. Now you'd probably want to separate the generation of
permutations from the actual code. There are for example some functions to
deal with such things in the widely used library alexandria
.
Upvotes: 1
Reputation: 642
You seem to be able to solve the problem using another language, so I won't spend too long talking about the problem/algorithm used (you already know how to do it). However, as it seems that you are learning Common Lisp, I am going to provide a typical StackOverflow answer, and give a lot of advice that you haven't asked for !
(some (lambda (x) (= x j)) occupied) == (member j occupied :test #'=)
, and in that case, it still works without specifying the test (this is technically wrong, the two functions do not return the same thing, but you only ever use the result as a boolean so this is effectively the same thing here).(mapcar (lambda (x y) (* x y)) ...)
is just a longer way to write (mapcar #'* ...)
'nil == nil
, you don't need to quote it. It is also (arguably) good style to use ()
instead of nil
to represent the empty list (as opposed to a boolean value), but this really is a minor point.As far as the algorithm is concerned, I will gladly help if you rewrite it using smaller functions. At the moment, it really is unnecessarily hard to read and understand.
EDIT: I still tried to take the time to rewrite the code and come up with a cleaner solution. TL;DR: this is the final result, with "minimal" modifications to your code:
(defun find! ()
(found? 0 (list 1 2 3) () 3))
(defun compute-lefthand (list)
(* 111 (reduce #'+ list)))
(defun compute-righthand (list)
(reduce #'+ (mapcar #'*
'(1000 100 10 1)
(list (third list)
(first list)
(first list)
(second list)))))
(defun check-solution (list)
(when (= (compute-lefthand list)
(compute-righthand list))
list))
(defun try-solution (j index list occupied width)
(unless (member j occupied)
(setf (nth index list) j)
(found? (1+ index)
list
(cons j occupied)
width)))
(defun found? (index lst occupied width)
(if (= index width)
(check-solution lst)
(dotimes (j 10)
(when (try-solution j index lst occupied width)
(return lst)))))
Your initial code, on top of style issues already mentioned in my initial answer, had shaky control flow. It was somewhat hard to determine what was really returned by each recursive call, because you do not have smaller functions and so it was not clear what the goal of each part was, how the information was transmitted from the recursive call to the parent, which objects where modified and so on. Now, my code is not the cleanest, and I would probably not use this strategy to solve the problem, but I tried to stay as close as possible to your initial code. Main differences:
check-solution
returns the list if it represents a proper solution, and nil
otherwise; this is made clear by the fact that I use a when
instead of an if
control structure.do
by dotimes
which is also clearer; the variable that is changing, and how it is changing at each step, is now immediately visible.&optional return
argument to the do/dotimes
macro, and instead use an explicit return
. It is then clear to determine what is being returned, and when.push/pop
to modify my lists. You are using a recursive strategy, and so your "modifications" should take the form of different arguments passed to functions. Once again, it makes reasoning about the program easier, by knowing exactly what each function does to each argument. An even better solution would also be to remove the call to setf
and instead use (cons <smtg> lst)
as the argument of the recursive call, but it's fine.The error in your initial program is probably coming from the fact that your function does not return what you think, because you have several consecutive expressions, each invoked under different circumstances, whose return value is itself wrong because they are not in the right order and modify objects and return them at the wrong time using do
's optional return value.
TL;DR: split things up; make each function do a single thing.
Upvotes: 1