Re: Another "gotta be a better way"

Ken Tilton wrote:

Mattias Nilsson wrote:

On Apr 22, 6:10 am, Ken Tilton <k...@theoryyalgebra.com> wrote:
[...]
>

Your mission, should you blah blah blah, is to take a list of field
outputs (again, a list whose last element is data, the rest a path) and
collapse them into the implied tree(s):
>
#+test
(time (tree-ify '((x one a 1)(x two a 2)(x three 42)(y two b 3)(x one b 4))))
;; 39 cons cells
;; -> ((Y (TWO (B 3))) (X (THREE 42) (TWO (A 2)) (ONE (B 4) (A 1))))

>
[...]
>
If I have understood the problem specification correctly, here's my
suggested solution:
>
(defun leaf-tree (leaf)
  (reduce #'list leaf :from-end t))
>
(defun insert-leaf (leaf tree)
  (let ((subtree (assoc (first leaf) (rest tree))))
    (if subtree
      (insert-leaf (second leaf) subtree)
      (push leaf (rest tree)))))
>
(defun tree-ify (data)
  (let ((tree (list 'root)))
    (dolist (d data tree)
      (insert-leaf (leaf-tree d) tree))))
>
I took the liberty of adding an extra root, since it made the code
nicer
(without it, INSERT-LEAF was split into two functions...).
>
I don't actually know if it's any better than your solution, but it
was a
fun excercise nonetheless.

 
Nice. I collapsed it into one and eliminated the root at the last second:
 
(defun tree-ify3 (data)
   (labels ((insert-leaf (leaf tree)
              (bif (subtree (assoc (first leaf) (rest tree)))
                (insert-leaf (second leaf) subtree)
                (push leaf (rest tree)))))
     (loop with tree = (cons nil nil)
         for path in data
         for leaf = (reduce #'list path :from-end t)
         for subtree = (assoc (first leaf) (rest tree))
         if subtree do (insert-leaf (second leaf) subtree)
         else do (push leaf (rest tree))
         finally (return (cdr tree)))))
But that bumps the cons count from 39 to 54 with the otherwise nifty
trick of making each flat list a tree at the get-go. Can we lose that?
 
(defun tree-ify4 (data)
   (labels ((list-tree (list)
              (reduce #'list list :from-end t))
            (insert-leaf (leaf tree)
              (bif (subtree (assoc (first leaf) (rest tree)))
                (insert-leaf (cdr leaf) subtree)
                (push (list-tree leaf) (rest tree)))))
     (loop with tree
         for leaf in data
         do (bif (subtree (assoc (first leaf) tree))
              (insert-leaf (cdr leaf) subtree)
              (setf tree (push (list-tree leaf) tree)))
         finally (return tree))))
 
Still consing 44 over 39. and it looks like we do not need the extra
root cons even temporarily.
 
btw, your use of reduce to convert a list to a tree was slick.

newLISP:

(define (put-in-alist alist items)
  (let (path '())
    ;; For all but last item.
    (dolist (item (slice items 0 -1))
      (push item path -1)
      (unless (assoc path alist)
        (if (null? (rest path))
          (push (list item)  alist -1)
          (push (list item) (assoc (slice path 0 -1) alist) -1))))
    (push (nth -1 items) (assoc path alist) -1)
    alist))

(set 'aslist '())
(setq aslist (put-in-alist aslist '(Y TWO B 3)))
(setq aslist (put-in-alist aslist '(X THREE 42)))
(setq aslist (put-in-alist aslist '(X TWO A 2)))
(setq aslist (put-in-alist aslist '(X ONE B 4)))
(setq aslist (put-in-alist aslist '(X ONE A 1)))

aslist
  ===>
((Y (TWO (B 3))) (X (THREE 42) (TWO (A 2)) (ONE (B 4) (A 1))))


(=
  '((Y (TWO (B 3))) (X (THREE 42) (TWO (A 2)) (ONE (B 4) (A 1))))
  '((Y (TWO (B 3))) (X (THREE 42) (TWO (A 2)) (ONE (B 4) (A 1)))))

true

(assoc '(X ONE B) aslist)
  ===>
(B 4)

(lookup '(X ONE B) aslist)
  ===>
4