Re: Effective use of destructive functions

[Pascal Bourguignon <pjb@informatimago.com>]

"achambers.home@googlemail.com" <achambers.home@googlemail.com> writes:

> Here's some code....
>
> (setq doc '(root (child 1 2) (child 3 4)))

If you plan to modify these conses,  you shouldn't let the reader
create them with quote.  Explicitely build these lists!

(setq doc (list 'root (list 'child 1 2) (list 'child 3 4)))


> (setq editable-child (car (cdr doc)))
> ;; (setq editable-child (mapcan (lambda (x)
> ;; 		       (cons x nil)) editable-child))
>
> (setcdr editable-child '(10 11))

Same with this one, if you plan to do a (setcar (cdr editable-child) 12),
use list:

  (setcdr editable-child (list 10 11))


> editable-child
> doc
>
> It seems that in the commented sexp, altering the symbol
> editable-child using setcdr has no effect on doc because the contents
> of editable-child is a copy of the contents of doc rather than a
> direct reference to a particular `place' in doc.
>
> This is a stripped down version of my real problem which is to
> creating a number of widgets out of the data in doc.  I want to make
> a :notify function for each widget that updates doc when an element of
> the tree is edited.
>
> My question is...How can you run the contents of editable-child
> through a mapping function, and keep the structure so that any changes
> to the return value carry on up to doc?

Indeed, mapcar builds a new list with the results of the function.

(let* ((a (list 1 2 3))
       (b (mapcar (lambda (x) (* 2 x)) a)))
  (list a b))
--> ((1 2 3) (2 4 6))

You wouldn't want to modify the list a when you build the list b...



In your case, you can modify each element of your list, without
touching the cdr of the cons cells of the list, by using map-into.

So instead of writing 

  (setq editable-child (mapcan (lambda (x) (cons x nil)) editable-child))

you'd write:

doc
--> (root (child 1 2) (child 3 4))

editable-child 
--> (child 1 2)

(map-into editable-child (function list) editable-child)
--> ((child) (1) (2))

doc
--> (root ((child) (1) (2)) (child 3 4))

editable-child
--> ((child) (1) (2))



Well, it's not in emacs AFAIK, so here is an emacs-cl implementation
of map-into; see  http://www.lispworks.com/documentation/HyperSpec/Body/f_map_in.htm    
for the specifications.


(require 'cl)
(require 'eieio)

(defclass iterator () ())
(defclass iterator-list   (iterator) ((head   :initarg :sequence :type list)))
(defclass iterator-vector (iterator) ((vector :initarg :sequence :type VECTOR)
                                      (index :initform 0)))


(defmethod end-of-sequence-p ((self iterator-list))
  (null (slot-value self 'head)))


(defmethod end-of-sequence-p ((self iterator-vector))
  (>= (slot-value self 'index) (length (slot-value self 'vector))))


(defmethod current-item ((self iterator-list))
  (car (slot-value self 'head)))


(defmethod current-item ((self iterator-vector))
  (aref (slot-value self 'vector) (slot-value self 'index)))


(defmethod set-current-item ((self iterator-list) value)
  (setf (car (slot-value self 'head)) value))


(defmethod set-current-item ((self iterator-vector) value)
  (setf (aref (slot-value self 'vector) (slot-value self 'index)) value))


(defmethod advance ((self iterator-list))
  (setf (slot-value self 'head) (cdr (slot-value self 'head))))


(defmethod advance ((self iterator-vector))
  (incf (slot-value self 'index)))


(defun map-into (result-sequence function &rest sequences)
  (cond
    ((every (function listp) sequences)
     (cond
       ((listp result-sequence)
        (do ((sequences sequences (mapcar (function cdr) sequences))
             (target result-sequence (cdr target)))
            ((or (null target) (some (function null) sequences)) result-sequence)
          (setf (car target) (apply function
                                    (mapcar (function car) sequences)))))
       ((vectorp* result-sequence)
        (do ((sequences sequences (mapcar (function cdr) sequences))
             (target 0 (1+ target)))
            ((or (>= target (length result-sequence))
                 (some (function null) sequences)) result-sequence)
          (setf (aref result-sequence target)
                (apply function (mapcar (function car) sequences)))))
       (t (error "RESULT-SEQUENCE is neither a LIST or a VECTOR."))))
    ((every (function vectorp*) sequences)
     (cond
       ((listp result-sequence)
        (do ((source 0 (1+ source))
             (min (apply (function min) (mapcar (function length) sequences)))
             (target result-sequence (cdr target)))
            ((or (null target) (>= source min)) result-sequence)
          (setf (car target) 
                (apply function (mapcar (lambda (seq) (aref seq source))
                                        sequences)))))
       ((vectorp* result-sequence)
        (do ((index 0 (1+ index))
             (min (apply (function min) (length result-sequence)
                         (mapcar (function length) sequences))))
            ((>= index min) result-sequence)
          (setf (aref result-sequence index)
                (apply function (mapcar (lambda (seq) (aref seq index))
                                        sequences)))))
       (t (error "RESULT-SEQUENCE is neither a LIST or a VECTOR."))))
    (t
     (do ((res
           (make-instance
               (cond 
                 ((listp    result-sequence) 'iterator-list)
                 ((vectorp* result-sequence) 'iterator-vector)
                 (t (error "RESULT-SEQUENCE is neither a LIST or a VECTOR.")))
             :sequence result-sequence))
          (sequences
           (mapcar
            (lambda (seq)
              (make-instance
                  (cond 
                    ((listp    seq) 'iterator-list)
                    ((vectorp* seq) 'iterator-vector)
                    (t (error "A SEQUENCE is neither a LIST or a VECTOR.")))
                :sequence seq)) sequences)))
         ((some (function end-of-sequence-p) (cons res sequences))
          result-sequence)
       (set-current-item res (apply function
                                    (mapcar (function current-item) sequences)))
       (dolist (seq (cons res sequences)) (advance seq))))))



(let ((result (make-list 10 0)))
   (print (map-into result (function +) '(1 2 3 4 5 6)
                                        '(100 200 300 400 500 600 700 800)))
   (print (map-into result (function *) result '(2 2 2 3 3 3)))
   (map-into result (lambda (x) (+ 1000 x)) result))

(101 202 303 404 505 606 0 0 0 0)

(202 404 606 1212 1515 1818 0 0 0 0)
(1202 1404 1606 2212 2515 2818 1000 1000 1000 1000)


-- 
__Pascal Bourguignon__
http://www.informatimago.com
http://pjb.ogamita.org