Home > Software design >  How to iterate through two unequal in length list in Common Lisp
How to iterate through two unequal in length list in Common Lisp

Time:10-03

Im trying to make a function that replaces the values of one list by values of another list if certain conditions are met.

For example, given l1 = ((x 1) (y 2)), l2 = (word x y c) I should get (1 2 c). My approach is to modify l2. I know how to do it with a loop but the loop stops at the shorter list and doesn't keep going.I have tried multiple methods and spent around 6 hours trying to come up with something but cannot.

Below is my code

(loop :for x :in (cdr l2):for (a b) in l1
    do(if (eql a x) (nsubst b x l2) ())
    return l2

)

It doesn't work for me, and just stop at the first thing so I get like (word replaced value c). It even doesn't work when l1 and l2 have the same size

CodePudding user response:

You are using two “parallel” iterations in your loop, but you should use two “nested” loops, that is one loop inside the other: the external one to scan trhough l2, the inner one to find the right substitution.

CL-USER> (defvar l1 (copy-list '((x 1) (y 2))))
L1
CL-USER> (defvar l2 (copy-list '(word x y c)))
L2
CL-USER> (loop for x in (cdr l2)
               do (loop for (a b) in l1
                    when (eql a x)
                    do (nsubst b x l2))
               finally (return l2))
(WORD 1 2 C)

CodePudding user response:

SUBLIS

First of all, note that Common Lisp has a function that can be useful fr your needs, SUBLIS:

USER> (sublis '((x . 1) (y . 2) (z . 3))
    '(some-tree 
       (with x 
         (and y z 
           (nested (list x y z))))))

(SOME-TREE (WITH 1 (AND 2 3 (NESTED (LIST 1 2 3)))))

You can also play with the key and test functions to cover a lot of use cases.

Recursive transform

This small comment of yours is in fact quite important:

To add another example, if input l1 = ((a 1 ) (b 2)) l2 = (word a b), I should get (word 1 2) but would only get (word 1 b)

You have basically two options here:

  • Call your transform function again and again until you reach a fixpoint, ie. there is no further replacement being made. For example you can call SUBLIS until the resulting form is EQUALP to the input form. Note that this might not terminate if for example you replace X by Y and Y by X.

  • Make a single pass version that use an intermediate resolve function that recursively finds the actual binding of symbols. Let's write the second approach because it is simpler to detect circularity in my opinion.

Resolve a symbol

You have a list of bindings (the environment), a symbol, and you must compute the non-symbol value transitively associated with your symbol:

(resolve 'x '((x . a) (y . 0) (a . b) (b . c) (c . y)))
=> 0

For example, let's start with a naive recursive function:

(defun resolve (value environment)
  (typecase value
    (symbol (let ((entry (assoc value environment)))
      (if entry
        (resolve (cdr entry) environment)
        (error "~S is unbound in ~S" value environment)))
    (t value)))

Some tests:

(resolve 3 nil)
=> 3

(resolve 'x '((x . a) (y . 0) (a . b) (b . c) (c . y)))
=> 0

So far so good, but there is a problem if your environment has a circular dependency between symbols:

(resolve 'x '((x . y) (y . a) (a . b) (b . c) (c . y)))
=> CONTROL STACK EXHAUSTED

Let's add a SEEN parameter that track which symbol has already been seen during our resolution process. I add an auxiliary function RECURSE so that I can avoid passing environment each time, and keep track of SEEN:

(defun resolve (value &optional environment)
  (labels ((recurse (value seen)
             (typecase value
               (symbol
                (assert (not (member value seen))
                        ()
                        "Circularity detected: ~s already seen: ~s"
                        value
                        seen)
                (let ((entry (assoc value environment)))
                  (if entry
                      (recurse (cdr entry) (cons value seen))
                      (error "~S is unbound in ~S" value environment))))
               (t value))))
    (recurse value nil)))

Some tests:

(resolve 3)
=> 3

(resolve 'x '((x . a) (y . 0) (a . b) (b . c) (c . y)))
=> 0

(resolve 'x '((x . y) (y . a) (a . b) (b . c) (c . y)))
=> Circularity detected: Y already seen: (C B A Y X)

Conclusion

Now that you can resolve one symbol, you should be able to resolve multiple symbols in a list (or a tree) of symbols.

  • Related