0

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?

Will Ness
  • 70,110
  • 9
  • 98
  • 181
Lars Malmsteen
  • 738
  • 4
  • 23

3 Answers3

3

The minimal edit needed to make your code work is the following three small changes (marked with ;;;; NB in the comments):

  1. You are not allowed to surgically modify the structure of a quoted list, as you do. It must be freshly allocated, for that.
(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 
          ) )
  1. You must change the structure of the code (moving one closing paren one line up) to always undo the 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))))))
  1. You also must actually return the result, once it is found (seen in the above snippet as well).

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 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 0s for some reason.

Will Ness
  • 70,110
  • 9
  • 98
  • 181
  • the OP code actually generates `A` first, then `B`, then `C`, and calculates `AAA+BBB+CCC=CAAB` to test for the valid answers, and puts them into `lst` as `[A,B,C]`. so, `999+888+111 == 1998`. – Will Ness Feb 05 '22 at 05:50
  • I am not surprised that the "fix" was easy, but I still think that OP solution is poorly conceived. It is barely recursive, with two loops inside the recursive process and a lot of mutation; I _think_ that this misses the point of this sort of exercise, hence my suggestion to rethink and rewrite from scratch. Of course, you did a good job answering the minimal change part of the question, which OP was pretty insistent about, and you included some other important observations. – ad absurdum Feb 05 '22 at 22:27
  • The code seems to be a translation from a C++ program that OP did initially include (this was removed after pressure from other commenters which I did not agree with). I think that the solution should have been written as a lisp solution from the start, and that either a nested loop or an entirely recursive solution would have been best. I was thinking about writing an entirely recursive solution, and I may yet, I just haven't had the time. – ad absurdum Feb 05 '22 at 22:27
  • re "poorely conceived and barely recursive" have you seen [this](https://stackoverflow.com/questions/49848994/how-to-generate-all-the-permutations-of-elements-in-a-list-one-at-a-time-in-lisp/49907365?r=SearchResults&s=1|14.8231#49907365) perchance? I do like this approach and its deeper currents... have you noticed the Norvig reference?.. :) I mean this whole *dynamically-built-nested-loops-as-backtracking-comptutational-structure-workin-at-innermost-level* thing kind of blows my mind a little bit... – Will Ness Feb 06 '22 at 00:26
  • and also [the other answer](https://stackoverflow.com/a/50087510/849891), calling the callback on the inside for each found value instead of building the whole list of them... which led me to this realization of *"monads are just [generalized nested loops](https://stackoverflow.com/search?q=user%3A849891+generalized+nested+loops)"*. this whole [tag:recursive-backtracking] thing demystified a whole lot of stuff for me. :) and _recursion_ being used to _build_ the structure which then performs the computation... this is deep. :) @adabsurdum – Will Ness Feb 06 '22 at 00:57
  • @adabsurdum I've edited in a version with a "transposed" control structure, with one `do` loop. --- to finish the above stream of thought, this kind of approach works for creating *any `n`*-level deep nested loops structure, so it's actually general, and non-trivial. it's just that here `n = 3`. so yeah, this is rediscovering the merits of the imperative programming a little bit. that's why it feels so unusual, I guess. – Will Ness Feb 06 '22 at 01:42
  • I don't disagree that combining functional and imperative approaches can be interesting and useful. But, and I may be wrong, I don't think that OP was doing this on purpose. The OP question seemed to come from a programming exercise which OP wanted to solve by recursion. One thing that I think I have observed with learners is that they often think of recursion as a way to loop instead of as a way to think about and decompose a problem to express a solution. C and C++ don't seem like great languages for teaching recursion anyway; recursive solutions can be awkward in these languages. – ad absurdum Feb 06 '22 at 02:18
  • I didn't review OP code as deeply as you have, but my sense was that the original C++ code was of the type that combines loops and mutation with recursion because it makes life easier, but not for any principled reason, and that OP lisp solution _inherited_ this feature through translation, not through thinking about recursion, which is to say that I think that OP lisp code was somewhat misguided. – ad absurdum Feb 06 '22 at 02:18
  • But, I don't think that the OP problem is a great fit for pure recursion to begin with. Three nested loops is much easier to implement (and probably more idiomatic in Common Lisp). Anyway, these are just opinions, and I could be all wet ;) – ad absurdum Feb 06 '22 at 02:18
  • Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/241766/discussion-between-will-ness-and-ad-absurdum). – Will Ness Feb 06 '22 at 05:20
1

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 !

  • Fix your parentheses/indentation, this will make the code clearer for you.
  • Split your code in more, smaller functions. You are solving a problem using a recursive function, with several parameters, and the function is more than twenty lines long. This makes it really hard to read and to debug.
  • Use built-in functions: (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:

  • I split things into smaller functions. This makes everything clearer, and above all, easier to test. Each function returns something clear. For example, 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.
  • I replace do by dotimes which is also clearer; the variable that is changing, and how it is changing at each step, is now immediately visible.
  • I do not use the &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.
  • I do not use 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.

Numbra
  • 620
  • 4
  • 8
  • Thank you for the answer but I'm afraid it doesn't show precisely which parts of the CL code I should change so that it delivers the expected result, i.e. the `(9 8 1)` (or in reverse order`(1 8 9)` ) – Lars Malmsteen Jan 31 '22 at 16:57
  • @LarsMalmsteen: that's the whole point of programming - it's about figuring out what's wrong. Numbra has called it out correctly - you need to rewrite your code. Try writing a predicate function, that takes three lists, (c c c), (b b b) and (a a a), and returns true if it equals (c a a b). Then loop over a, b, c, create the lists, and get the result. – Francis King Jan 31 '22 at 17:53
  • the indentation was OK actually, they just used tabs for 8 spaces, while SO printed them as 4 spaces. – Will Ness Feb 04 '22 at 18:44
  • BTW, regarding _"what was really returned by each recursive call[?] ... it was not clear ... how the information was transmitted from the recursive call to the parent," the point of the OP code is to _not_ do all that functional stuff -- _at all_. it is (supposed to, when fixed, to be) working under a completely different paradigm, which I could even call "inverted control". I explain it more in my answer here and in [this other related answer](https://stackoverflow.com/a/49907365/849891) of mine, in case you're interested. – Will Ness Feb 04 '22 at 21:12
  • (@FrancisKing on a tangential note, I really don't understand why your answer here received two dv's). – Will Ness Feb 04 '22 at 21:13
1

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.

Svante
  • 50,694
  • 11
  • 78
  • 122
  • the indentation was OK actually, they just used tabs for 8 spaces, while SO printed them as 4 spaces for some reason. – Will Ness Feb 04 '22 at 18:45
  • Using tabs for spaces is not OK in my view ;-) — I think this case also shows why. – Svante Feb 04 '22 at 20:15
  • of course, fully agree. – Will Ness Feb 04 '22 at 20:16
  • re permutations, may I interest you with [this answer](https://stackoverflow.com/a/49907365/849891) of mine? (in case you haven't see it at the time). it is also relevant to this entry. – Will Ness Feb 04 '22 at 20:31
  • all it was, here, was one paren one line down from its right place. (and the `return-from` of course as you've pointed out first). only the innermost `return-from` is consequential, the other one is a dud, as I explain in my answer. :) also, surgically manipulating the result `lst` makes sense here actually, avoiding lots of consing. – Will Ness Feb 04 '22 at 20:49