Search code examples
listcommon-lisp

How to iterate through two unequal in length list in Common Lisp


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


Solution

  • SUBLIS

    First of all, note that Common Lisp defines a standard function that can be useful when doing term rewriting, namely 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 arguments to cover a lot of use cases.

    Recursive transform

    This small comment of yours is however 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)

    As far as I know you have basically two options here:

    1. 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 algorithm might not terminate if for example you replace X by Y and Y by X.

    2. Make a single pass version that use an intermediate resolve function, which recursively finds the actual binding of each symbol.

    Let's write the second approach because it is simpler to detect circularity in my opinion.

    Resolve a symbol

    Given an association list of bindings (the environment), a symbol, let's define resolve so that it finds 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
    

    Tracing the calls to resolve shows that the function calls itself indefinitely:

      0: (RESOLVE X ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
        1: (RESOLVE Y ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
          2: (RESOLVE A ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
            3: (RESOLVE B ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
              4: (RESOLVE C ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
                5: (RESOLVE Y ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
                  6: (RESOLVE A ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
                    7: (RESOLVE B ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
                      8: (RESOLVE C ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
                        9: (RESOLVE Y ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
                        9: RESOLVE exited non-locally
    

    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.