Path: ...!weretis.net!feeder8.news.weretis.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: Another "gotta be a better way"
Date: Fri, 9 Aug 2024 03:20:05 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 121
Message-ID: <v941sn$i83p$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Fri, 09 Aug 2024 05:20:05 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="97382f095ba3ac4cbc7925e852338930";
	logging-data="598137"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/Xg0HrO9kyKuQxUSmFb7ih"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:sKOcTLCf1H1FzFSX6fhL+QW4+aQ=
Bytes: 4766

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