Question: Mapping into a tree of nested sequences

Question

Mapping into a tree of nested sequences

Answers 2
Added at 2016-12-17 18:12
Tags
Question

I've coded a function that aims to map into an arbitrary tree of nested proper lists, somewhat analogous to the common lisp function map-into:

(defun map-into-tree (fn tree)
  "Destructive mapping into a proper tree."
  (cond ((null tree) nil)
        ((atom (car tree)) 
         (setf (car tree) (funcall fn (car tree))) 
         (map-into-tree fn (cdr tree)))
        (t (map-into-tree fn (car tree)) 
           (map-into-tree fn (cdr tree)))))

(defparameter *tree* '(1 (2) ((3)) (4 5) (6 ((7)))))
*TREE*

(map-into-tree #'1+ *tree*)
NIL

*tree*
(2 (3) ((4)) (5 6) (7 ((8))))

However, I'm not sure how to go about generalizing it for arbitrary nested sequences (like map-into for sequences). Any assistance is appreciated.

Answers
nr: #1 dodano: 2016-12-17 19:12

Here is a possible solution:

(defun map-into-nested-list (fn nested-list)
  "Destructive mapping into a nested-list."
  (cond ((null nested-list) nil)
        ((atom (car nested-list)) 
         (when (car nested-list) (setf (car nested-list) (funcall fn (car nested-list))))
         (map-into-nested-list fn (cdr nested-list)))
        ((atom (cdr nested-list)) 
         (when (cdr nested-list) (setf (cdr nested-list) (funcall fn (cdr nested-list))))
         (map-into-nested-list fn (car nested-list)))
        (t (map-into-nested-list fn (car nested-list)) 
           (map-into-nested-list fn (cdr nested-list)))))

(defvar *a* (copy-tree '((9 10) (8 9 10 11 (12 13) () (11) () 13))))
;; => *A*
(map-into-nested-list #'1+ *a*)
;; => NIL
*a*
;; => ((10 11) (9 10 11 12 (13 14) NIL (12) NIL 14))

The function is similar to map-into-tree: the main differences are that there is a new, symmetric, branch in the conditional for the case in which the cdr is an atom, and the test for the “atomic” cases to apply the function fn only if the atoms are different from NIL.

nr: #2 dodano: 2016-12-17 19:12

You could call map-into ;-)

(defun map-into-tree (function tree)
  (labels
      ((recurse (tree)
         (typecase tree
           (sequence (map-into tree #'recurse tree))
           (t (funcall function tree)))))
    (recurse tree)))

... or equivalently:

(defun map-into-tree (function tree)
  (typecase tree
    (sequence (map-into tree (lambda (u) (map-into-tree function u)) tree))
    (t (funcall function tree))))

Test:

(map-into-tree #'1+ (copy-tree '((9 10) (8 9 10 11 (12 13) () (11) () 13))))
=> ((10 11) (9 10 11 12 (13 14) NIL (12) NIL 14))

I am not sure what should happen with a tree which contains strings: do we really want to iterate over each character? As a matter of fact, this is what is done here above.

I also notice that map-into works with sequences containing cons cells, but the corresponding map-into-tree does not, even though it uses map-into.

(1 (2 . 3)) is a proper list with two elements, namely 1 and (2 . 3). Since map-into does not recurse into elements, all it does is calling the function on both those elements. In your comment, this was print, which can print improper lists without problems.

The second element is a sequence: when you call map-into-tree, the function recursively calls map-into with this sequence, which happens to be an improper list. map-into expects a proper sequence and thus fails with improper lists.

Please note that in your question, you said:

a function that aims to map into an arbitrary tree of nested proper lists

A tree with improper lists is not a valid input.

Finally, I notice you call destructive functions on literal data, like so:

(map-into #'print '(1 2))

The quoted list is a constant, modifying it at runtime is undefined behavior. That's why I first used copy-tree in my example.

So would this work to handle all special cases [...]

Since there is already a typecase in place, it is sufficient to handle the special case of the cons; that works regardless of the type of value held in the cdr slot:

(defun map-into-tree (function tree)
  (labels
      ((walk (tree)
         (typecase tree
           (cons
            (prog1 tree
              (setf (car tree) (walk (car tree)))
              (setf (cdr tree) (walk (cdr tree)))))
           (sequence (map-into tree #'walk tree))
           (t (funcall function tree)))))
    (walk tree)))
Source Show
◀ Wstecz