;;; Duplicating every cons cell in a list

;;; This function duplicates avery cons cell and their linkage,
;;   replaces atoms with symbol x 
;;;    E.g.: (1 ((2) 3) (((4)))) -> 
;;           (x ((x) x) (((x))))
(defun deepx (l)
  (cond ((null l) nil)
        ((atom l) 'x)
        ((consp l)
         (cons (deepx (car l))
               (deepx (cdr l))))))

(deepx '(1 ((2) 3) (((4)))))
;       (x ((x) x) (((x))))
 
(deepx '(1))
; (x)

(deepx '(1 w))
; (x x)

;;; This function replicates every cons cell, and replaces all atoms
;;;   with a number representing the order in which it visited them,
;;;    depth-first. 
;;;  E.g.: (a ((c) r) (((x)))) ->
;;;        (1 ((2) 3) (((4))))
(defun dft-num (l)
  (let ((c 0))
    (labels ((dft-aux (x)
                      (cond ((null x) nil)
                            ((atom x) (setq c (+ 1 c))) ; setq returns the new value
                            ((consp x)
                             (cons (dft-aux (car x))
                                   (dft-aux (cdr x)))))))
      
      (dft-aux l))))

(dft-num '(a ((c) r) (((x)))))
;         (1 ((2) 3) (((4))))

;;;; Nasty implementation of breadth-first search, following imperative pseudo-code 
;;;;   with a loop. These setqs are ugly and unnecessary; see recursive implementation
;;;;   below!
(defun bfs-loop (l)
  (let ((q (cons l nil))     ; or: (q (list l)), add root of the tree to the queue
        (res ()))            ; result list
    (while (not (null q))    ; while the q is not empty 
      (let ((n (car q))      ;   get a tree node pointer off the queue
            (rest (cdr q)))  ;   ...and the rest of the queue
        (setq q rest)        ;   this removes n from the queue
        ;(print (format "node: %s q: %s" n q))
        (if (atom (car n))   
            ;; if this is a leaf node, append atom in the leaf to result
            ;;   and then add all its siblings to the queue
            (progn (setq res (cons (car n) res)) 
                   ;; nconc requires its second argument to be a list;
                   ;;   we also want to pass a shallow copy of the list level, not
                   ;;   the cons cells of the tree themselves!
                   ;;   mapcar creates a shallow copy and wraps the sibling nodes as nconc needs
                   ;;     DEBUG: (print (format "(nconc %s %s)" q (mapcar (lambda (x) (list x)) (cdr n))))
                   (setq q (nconc q (mapcar (lambda (x) (list x)) (cdr n)))))
          ;; this is not a leaf node, push it to the back of the queue, after the siblings
          (progn (setq q (nconc q (mapcar (lambda (x) (list x)) (cdr n))))
                 (setq q (nconc q (list (car n))))))))
    (nreverse res)))  ;; reverse the result
bfs-loop

(bfs-loop '(1 2 3))
; (1 2 3)

(bfs-loop '(1 (2) 3))
; (1 3 2)

(bfs-loop '((1) (2) 3))
; (3 1 2)

(bfs-loop '(((1)) (2) 3))
; (3 2 1)

;;; This is a much more natural implementation. Processing the queue is
;;;   done via tail-recursion; no need for setqs.
;;;   Destructively adding to a queue is broken out into a separate small
;;;   function; labels conveniently allows several functions (just like
;;;    let allows several variable bindings)
(defun bfs-rec (l)
  (let ((q (list l)))
    (labels ((add-to-queue (queue lst)  ; add nodes from lst to queue, destructively
                           (nconc queue (mapcar (lambda (x) (list x)) lst)))
             (bfs-aux (q acc)           ; queue processor, instead of the loop
                      (if (null q) acc      ; if no more nodes on the queue, return the result list
                        (let ((n (car q))   ; get next node off the queue 
                              (q (cdr q)))  ;  ..and ajdust the queue
                          (if (atom (car n))                    ; if the node is a leaf
                              (bfs-aux (add-to-queue q (cdr n)) ;  ...add siblings to queue 
                                       (cons (car n) acc))      ;  ...add its atom to result
                            ;; otherwise it's not a leaf, add it to queue _after_ siblings
                            (bfs-aux (add-to-queue (add-to-queue q (cdr n)) ; add siblings
                                                   (car n))                 ; add the non-leaf to the back
                                     acc)))))) ; pass result unchanged
      (nreverse (bfs-aux q ())))))

(bfs-rec '((1) (2) 3 4))
; (3 4 1 2)

(bfs-rec '(((1)) (2) 3 4))
; (3 4 2 1)

(bfs-rec '(1 (2) 3 4))
; (1 3 4 2)

(bfs-rec '(1 (2 5) 3 4))
(1 3 4 2 5)

(bfs-rec '(1 ((2) 5) 3 4))
(1 3 4 5 2)

;;-----------------------------------------------------------------------------
;; testing add-to-queue 
(defun add-to-queue (queue lst) 
  (nconc queue (mapcar (lambda (x) (list x)) 
                       lst)))
;add-to-queue

(setq ll '(a b c))
; (a b c)

; the queue starts as ((a b c)), pointer to whole tree:
(setq qq (list ll))
; ((a b c))

; once we remove a and add it to the result, we want the queue to be ((b) (c)).
;  we have (cdr ll), which is (b c)
(add-to-queue (cdr qq) (cdr ll))
((b) (c))

; note that for nested lists this works too:
(setq ll '(a (b d) c))
; (a (b d) c)

(setq qq (list ll))
; ((a (b d) c))

(add-to-queue (cdr qq) (cdr ll))
;(((b d)) (c))

;=========================[ UPDATE: HW2 P3 hint ]=======================

Initially, I thought that re-filling a tree in a breadth-first order
traversal would be best done by adapting the BFS walk to RPLACA the
leaf cons cells from an sorted list. 

However, the BFS implementation above does not keep track of the
original tree's cons cells, and so some RPLACAs went off target,
and it took me a while to debug it code. If you got that right,
I will give you extra credit! 

But there's an easier way to do the problem, using a combination of
dft-num to build a copy of the tree with nodes numbered in the order
DFT traverses them, a BFT read-out of these node numbers into a list,
and then rebuilding the tree using that list as a source for the new
order. It works as follows:

So let's say we have a list of x's and cons cells like (x ((x) x) (((x)))) 
and we want to place numbers 100 200 300 400 in these instead
of x's so that in BFT they come out in order.

We know how to duplicate the tree depth-first, how to fill it with
the numbers that signify the order the nodes are seen in DFT, and we
have a function for BFT:

(setq ll '(x ((x) x) (((x)))))
;(x ((x) x) (((x))))

(dft-num ll)
;(1 ((2) 3) (((4))))

(bfs-rec (dft-num ll))
;(1 3 2 4)

So we know in which order the nodes seen in depth-first order come out
in breadth-first traversal. This is the key. Say, if we want the
smallest number to be seen first in BFT, we put it at node 1. The next
number we need to put in node 3 of DFT, because it will come out
second in BFT. The next number should go in node 2 of DFT, because in
BFT it comes out 3rd, and the last goes in node 4.

A convenient way to reprsesent this info is with an association list:

;; this is simply mapcar in Common Lisp like GCL or SBCL, but mapcar*
;;   in LISP.
> (mapcar* (lambda (x y) (cons x y)) '(1 3 2 4) '(100 200 300 400))
; ((1 . 100) (3 . 200) (2 . 300) (4 . 400))

Then if you need to look up what goes in node 3, you can do:

> (assoc 3 '((1 . 100) (3 . 200) (2 . 300) (4 . 400)))
; (3 . 200)

Or (defun alist-get (k lst) (cdr (assoc k lst)))

and 

(alist-get 3 '((1 . 100) (3 . 200) (2 . 300) (4 . 400)))
; 200

Now we just need to make a DFT copy with that order, or replace
the cars of an existing copy, again in DFT order, just looking
up what to put in the node by its number in the alist. We should get 
(100 ((300) 200) (((400))))

Indeed:
(bfs-rec '(100 ((300) 200) (((400)))))
; (100 200 300 400) 

Another test:


(setq ll '(((x)) ((x) x) (((x)))))
;(((x)) ((x) x) (((x))))

(dft-num ll)
;(((1)) ((2) 3) (((4))))

(bfs-rec (dft-num ll))
;(3 1 2 4)

(dft-reordering-copy ll 
                     '(3 1 2 4)
                     '(aa bb cc dd))
;(((bb)) ((cc) aa) (((dd))))

;; checking:
(bfs-rec '(((bb)) ((cc) aa) (((dd)))))
;(aa bb cc dd)