From: Ken Tilton
Subject: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <1fBWh.43$4e3.4@newsfe12.lga>
Set-up: we have traversed a GUI data form and come up with the data to
be written out, in a manner to be specified next. We want output to be
orthogonal to view, so any field is free to return (here comes the
manner) a list whose last item is the field data and everything up to
that is understood to be a path of names down some schema tree (again,
orthogonal to the form tree) to the data, the last path item being thus
a "field name" and everything above it being nested group/structures.
Corrollary: no path can be both a field (have data) and also a group
with substructure. Finally, we must allow for one form to specify
multiple data trees, ie, multiple roots.
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))))
scroll way down for my lightly tested version.
(defun tree-ify (data &aux leafs subtrees)
(loop for d in data
if (not (third d)) do (push d leafs)
else do (unless (assoc (car d) subtrees)
(push (cons (car d)
(tree-ify (mapcar 'cdr (remove (car d) data
:key 'car :test-not 'eql))))
subtrees))
finally (return (nconc leafs subtrees))))
Notes:
- I offer these when something that seems like it should be easy makes
me think more than I expected, and when I do not like my solution, and
when they seem general enough to be fun, esp. for noobs
- I especially hate the consing of the remove for the nested call to
tree-ify; this is where I sense a better way is possible
- Note that this does rely on the spec's guarantee that no group can
also have data associated with it.
- I should have made clear: only leafs return specifications, groups let
their leaves define them. Corr: all inputs end in data.
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
On Apr 22, 6:10 am, Ken Tilton <····@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.
Mattias.
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <k_JWh.3$Ju7.2@newsfe12.lga>
Mattias Nilsson wrote:
> On Apr 22, 6:10 am, Ken Tilton <····@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.
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
On Apr 22, 4:07 pm, Ken Tilton <····@theoryyalgebra.com> wrote:
> [...]
> (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.
Those two BIFs look like the two functions I had at first.
I hadn't thought of delaying the calls to LIST-TREE until they were
actually needed, though...
> btw, your use of reduce to convert a list to a tree was slick.
Just yesterday, I found a definition of COMPOSE (function
composition) in PAIP which did something similar, so I'm not
sure I would have thought of it otherwise. :)
At the moment, I can't see any obvious improvements that
could be made to this method, so I'll leave it for you...
Mattias.
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <lPMWh.255$Z85.165@newsfe12.lga>
Mattias Nilsson wrote:
> On Apr 22, 4:07 pm, Ken Tilton <····@theoryyalgebra.com> wrote:
>
>>[...]
>>(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.
>
>
> Those two BIFs look like the two functions I had at first.
Sorry:
(defmacro bif ((bindvar boundform) yup &optional nope)
`(let ((,bindvar ,boundform))
(if ,bindvar
,yup
,nope)))
> I hadn't thought of delaying the calls to LIST-TREE until they were
> actually needed, though...
>
>
>>btw, your use of reduce to convert a list to a tree was slick.
>
>
> Just yesterday, I found a definition of COMPOSE (function
> composition) in PAIP which did something similar, so I'm not
> sure I would have thought of it otherwise. :)
>
> At the moment, I can't see any obvious improvements that
> could be made to this method, so I'll leave it for you...
It just occurred to me that this is the last processing step on
uncontested list structure, gonna try delete instead of remove... no,
hang on, I would need to bifurcate the list, pass the matches, keep the
mismatches for the next iteration.
Horse. Dead. Please don't beat?
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
Mattias Nilsson <········@bredband.net> writes:
> On Apr 22, 6:10 am, Ken Tilton <····@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))))
> [...]
>
> (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 think that the tree can be built directly by a two
recursive calls
(defun shave (item list)
"a ((a 1)(b 2)(a 3)) => ((1)(3))"
(loop for (first . rest) in list
if (eql item first) collect rest)
(defun tree-ify1 (list)
(and list (car list)
(let ((node (caar list)))
(cons (cons node
(tree-ify1 (shave node list)))
(tree-ify1 (remove node list :key #'car))))))
CL-USER> (tree-ify1 '((x one a 1)(x two a 2)(x three 42)(y two b 3)(x one b 4)))
((X (ONE (A (1)) (B (4))) (TWO (A (2))) (THREE (42))) (Y (TWO (B (3)))))
I wonder if the code is any clearer written like this?
(defun tree-ify1 (list)
(and list (car list)
(let* ((node (caar list))
(below (tree-ify1 (shave node list)))
(beside (tree-ify1 (remove node list :key #'car))))
`((,node ,@below) ,@beside)
)))
It doesn't meet the spec because it recurses all the way to
the bottom. Can be fixed:
(defun tree-ify2 (list)
(cond ((endp list) nil)
((two-list-p (car list)) list)
(t (let ((node (caar list)))
(cons (cons node
(tree-ify2 (shave node list)))
(tree-ify2 (remove node list :key #'car)))))))
(defun two-list-p (list)
(not (cddr list)))
Alan Crowe
Edinburgh
Scotland
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <ldaXh.43$kT7.11@newsfe12.lga>
Alan Crowe wrote:
> Mattias Nilsson <········@bredband.net> writes:
>
>
>>On Apr 22, 6:10 am, Ken Tilton <····@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))))
>>
>>[...]
>>
>>(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 think that the tree can be built directly by a two
> recursive calls
>
> (defun shave (item list)
> "a ((a 1)(b 2)(a 3)) => ((1)(3))"
> (loop for (first . rest) in list
> if (eql item first) collect rest)
>
> (defun tree-ify1 (list)
> (and list (car list)
> (let ((node (caar list)))
> (cons (cons node
> (tree-ify1 (shave node list)))
> (tree-ify1 (remove node list :key #'car))))))
>
> CL-USER> (tree-ify1 '((x one a 1)(x two a 2)(x three 42)(y two b 3)(x one b 4)))
> ((X (ONE (A (1)) (B (4))) (TWO (A (2))) (THREE (42))) (Y (TWO (B (3)))))
>
> I wonder if the code is any clearer written like this?
>
> (defun tree-ify1 (list)
> (and list (car list)
> (let* ((node (caar list))
> (below (tree-ify1 (shave node list)))
> (beside (tree-ify1 (remove node list :key #'car))))
> `((,node ,@below) ,@beside)
> )))
>
> It doesn't meet the spec because it recurses all the way to
> the bottom. Can be fixed:
>
> (defun tree-ify2 (list)
> (cond ((endp list) nil)
> ((two-list-p (car list)) list)
> (t (let ((node (caar list)))
> (cons (cons node
> (tree-ify2 (shave node list)))
> (tree-ify2 (remove node list :key #'car)))))))
>
> (defun two-list-p (list)
> (not (cddr list)))
Sweet. Conses only 35. The shave function persuaded me to do the
destructive version, btw.
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
Ken Tilton <···@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))))
+---------------
Not sure I can contribute any code more useful than the other branch
of this thread [some cute stuff in there], but one thought comes to
mind from the problem statement: If you consider each element of an
input "list of field outputs" to be a "character" [yes, I know it isn't],
then this task smells an awful lot like inserting into a "trie", and
some study of trie algorithms might prove useful.
Oh, and there was some discussion that might be related to this
back in August '02, in the thread "Q: modularity problem with CLOS".
Tim Bradshaw's "generic trees" & INTERN-SEQUENCE-IN-GT come to mind in
particular, see <····················@cley.com>, et seq in which Rahul
Jain says that GTs are really tries, or maybe "discrimination nets".
["Ternary search trees" were also mentioned.]
That's all I've got. Sorry it's not more...
-Rob
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
> 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))))
first off, I have no idea what the majority of this rambling
incoherent post is ;-) but based on the kindergarden metric ("make
yours like mine"), here's my attempt:
(defun tree<-list (x)
(when x
(if (rest x)
(list (first x) (tree<-list (rest x)))
x)))
;see below for version without if*
(defun fn (list path)
(when path
(let ((a (assoc (first path) (rest list))))
(if* a
then (if* (rest a)
then (fn a (rest path))
else (setf (rest a) (tree<-list (rest path))))
else (setf (rest list)
(list* (tree<-list path) (rest list))))
list)))
cl-user> (funcall (compile nil
(lambda (x)
(time (reduce #'fn x :initial-value (list :root)))))
x)
; cpu time (non-gc) 0 msec user, 0 msec system
; cpu time (gc) 0 msec user, 0 msec system
; cpu time (total) 0 msec user, 0 msec system
; real time 0 msec
; space allocation:
; 31 cons cells, 0 other bytes, 0 static bytes
(:root (y (two (b (3))))
(x (three (42)) (two (a (2))) (one (b (4)) (a (1)))))
;(defun fn (list path)
; (when path
; (let ((a (assoc (first path) (rest list))))
; (if a
; (if (rest a)
; (fn a (rest path))
; (setf (rest a) (tree<-list (rest path))))
; (setf (rest list)
; (list* (tree<-list path) (rest list))))
; list)))
From: Dan Bensen
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <f0hkge$avk$1@wildfire.prairienet.org>
>> ;; 39 cons cells
········@gmail.com wrote:
> ; space allocation:
> ; 31 cons cells, 0 other bytes, 0 static bytes
Is there a way to get this info from sbcl?
time and profile keep saying "0 bytes consed",
even though the code works.
--
Dan
www.prairienet.org/~dsb/
Hi. This is my noob try, so all comments are welcome.
(defun my-tree-ify (data)
(let ((r '()))
(dolist (k data)
(let ((j (assoc (car k) r)))
(cond (j (setf (cdr j) (append (cdr j) (list (cdr k)))))
((third k) (setf r (cons (cons (car k) (list (cdr k))) r)))
(t (setf r (cons k r))))))
(dolist (k r r)
(unless (atom (second k))
(setf (cdr k) (my-tree-ify (cdr k)))))))
CL-USER> (my-tree-ify '((X ONE A 1) (X TWO A 2) (X THREE 42) (Y TWO B
3) (X ONE B 4)))
=>((Y (TWO (B 3))) (X (THREE 42) (TWO (A 2)) (ONE (B 4) (A 1))))
I did some benchmarking in SBCL: (with (declaim (optimize (speed 0)
(space 0) (safety 3) (debug 3))))
(defparameter m '((x one a 1)(x two a 2)(x three 42)(y two b 3)(x one
b 4)))
Yours:
CL-USER> (time (dotimes (s 10000) (tree-ify m)))
Evaluation took:
0.14 seconds of real time
0.140008 seconds of user run time
0.0 seconds of system run time
0 calls to %EVAL
0 page faults and
4,394,696 bytes consed.
Mine:
CL-USER> (time (dotimes (s 10000) (my-tree-ify m)))
Evaluation took:
0.021 seconds of real time
0.016001 seconds of user run time
0.004 seconds of system run time
0 calls to %EVAL
0 page faults and
3,120,424 bytes consed
Mattias'
CL-USER> (time (dotimes (s 10000) (tree-ify5 m)))
Evaluation took:
0.029 seconds of real time
0.028002 seconds of user run time
0.0 seconds of system run time
0 calls to %EVAL
0 page faults and
4,241,536 bytes consed.
Mattias' modified by you
CL-USER> (time (dotimes (s 10000) (tree-ify4 m)))
Evaluation took:
0.029 seconds of real time
0.024001 seconds of user run time
0.0 seconds of system run time
0 calls to %EVAL
0 page faults and
3,203,056 bytes consed.
Alan's (his last one)
CL-USER> (time (dotimes (s 10000) (tree-ify2 m)))
Evaluation took:
0.029 seconds of real time
0.028001 seconds of user run time
0.0 seconds of system run time
0 calls to %EVAL
0 page faults and
2,641,920 bytes consed.
-Leandro
On 22 abr, 01:10, Ken Tilton <····@theoryyalgebra.com> wrote:
> Set-up: we have traversed a GUI data form and come up with the data to
> be written out, in a manner to be specified next. We want output to be
> orthogonal to view, so any field is free to return (here comes the
> manner) a list whose last item is the field data and everything up to
> that is understood to be a path of names down some schema tree (again,
> orthogonal to the form tree) to the data, the last path item being thus
> a "field name" and everything above it being nested group/structures.
> Corrollary: no path can be both a field (have data) and also a group
> with substructure. Finally, we must allow for one form to specify
> multiple data trees, ie, multiple roots.
>
> 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))))
>
> scroll way down for my lightly tested version.
>
> (defun tree-ify (data &aux leafs subtrees)
> (loop for d in data
> if (not (third d)) do (push d leafs)
> else do (unless (assoc (car d) subtrees)
> (push (cons (car d)
> (tree-ify (mapcar 'cdr (remove (car d) data
> :key 'car :test-not 'eql))))
> subtrees))
> finally (return (nconc leafs subtrees))))
>
> Notes:
> - I offer these when something that seems like it should be easy makes
> me think more than I expected, and when I do not like my solution, and
> when they seem general enough to be fun, esp. for noobs
> - I especially hate the consing of the remove for the nested call to
> tree-ify; this is where I sense a better way is possible
> - Note that this does rely on the spec's guarantee that no group can
> also have data associated with it.
> - I should have made clear: only leafs return specifications, groups let
> their leaves define them. Corr: all inputs end in data.
>
> kt
>
> --http://www.theoryyalgebra.com/
>
> "Algebra is the metaphysics of arithmetic." - John Ray
>
> "As long as algebra is taught in school,
> there will be prayer in school." - Cokie Roberts
>
> "Stand firm in your refusal to remain conscious during algebra."
> - Fran Lebowitz
>
> "I'm an algebra liar. I figure two good lies make a positive."
> - Tim Allen
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <W69Xh.1304$pz1.776@newsfe12.lga>
··················@gmail.com wrote:
> Hi. This is my noob try, so all comments are welcome.
>
> (defun my-tree-ify (data)
> (let ((r '()))
> (dolist (k data)
> (let ((j (assoc (car k) r)))
> (cond (j (setf (cdr j) (append (cdr j) (list (cdr k)))))
> ((third k) (setf r (cons (cons (car k) (list (cdr k))) r)))
> (t (setf r (cons k r))))))
> (dolist (k r r)
> (unless (atom (second k))
> (setf (cdr k) (my-tree-ify (cdr k)))))))
Nice. Only tip: (push x y) expands to (setf y (cons x y)), so:
(defun my-tree-ify (data)
(loop with r ;; loop for the fun of it
for k in data
for j = (assoc (car k) r)
do (cond
(j (setf (cdr j) (append (cdr j) (list (cdr k)))))
((third k) (push (cons (car k) (list (cdr k))) r))
(t (push k r)))
finally
(loop for k in r
do (when (consp (second k)) ;; I like positive tests
(setf (cdr k) (my-tree-ify (cdr k)))))
(return r)))
>
> CL-USER> (my-tree-ify '((X ONE A 1) (X TWO A 2) (X THREE 42) (Y TWO B
> 3) (X ONE B 4)))
> =>((Y (TWO (B 3))) (X (THREE 42) (TWO (A 2)) (ONE (B 4) (A 1))))
>
>
> I did some benchmarking in SBCL: (with (declaim (optimize (speed 0)
> (space 0) (safety 3) (debug 3))))
>
> (defparameter m '((x one a 1)(x two a 2)(x three 42)(y two b 3)(x one
> b 4)))
>
> Yours:
>
> CL-USER> (time (dotimes (s 10000) (tree-ify m)))
> Evaluation took:
> 0.14 seconds of real time
> 0.140008 seconds of user run time
> 0.0 seconds of system run time
> 0 calls to %EVAL
> 0 page faults and
> 4,394,696 bytes consed.
5-7 times slower? On ACL I lose just by 141 msec to 79 msec, and 38 cons
to 31. I think the yobs sabotaged SBCL to run kennycode slower.
I am working on a destructive version now, see if I can get it down to 9
conses. Beats working. :)
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <W_9Xh.40$kT7.2@newsfe12.lga>
Ken Tilton wrote:
>
>
> ··················@gmail.com wrote:
>
>> Hi. This is my noob try, so all comments are welcome.
>>
>> (defun my-tree-ify (data)
>> (let ((r '()))
>> (dolist (k data)
>> (let ((j (assoc (car k) r)))
>> (cond (j (setf (cdr j) (append (cdr j) (list (cdr k)))))
>> ((third k) (setf r (cons (cons (car k) (list (cdr k))) r)))
>> (t (setf r (cons k r))))))
>> (dolist (k r r)
>> (unless (atom (second k))
>> (setf (cdr k) (my-tree-ify (cdr k)))))))
>
>
> Nice. Only tip: (push x y) expands to (setf y (cons x y)), so:
>
> (defun my-tree-ify (data)
> (loop with r ;; loop for the fun of it
> for k in data
> for j = (assoc (car k) r)
> do (cond
> (j (setf (cdr j) (append (cdr j) (list (cdr k)))))
> ((third k) (push (cons (car k) (list (cdr k))) r))
> (t (push k r)))
> finally
> (loop for k in r
> do (when (consp (second k)) ;; I like positive tests
> (setf (cdr k) (my-tree-ify (cdr k)))))
> (return r)))
>
>
>>
>> CL-USER> (my-tree-ify '((X ONE A 1) (X TWO A 2) (X THREE 42) (Y TWO B
>> 3) (X ONE B 4)))
>> =>((Y (TWO (B 3))) (X (THREE 42) (TWO (A 2)) (ONE (B 4) (A 1))))
>>
>>
>> I did some benchmarking in SBCL: (with (declaim (optimize (speed 0)
>> (space 0) (safety 3) (debug 3))))
>>
>> (defparameter m '((x one a 1)(x two a 2)(x three 42)(y two b 3)(x one
>> b 4)))
>>
>> Yours:
>>
>> CL-USER> (time (dotimes (s 10000) (tree-ify m)))
>> Evaluation took:
>> 0.14 seconds of real time
>> 0.140008 seconds of user run time
>> 0.0 seconds of system run time
>> 0 calls to %EVAL
>> 0 page faults and
>> 4,394,696 bytes consed.
>
>
> 5-7 times slower? On ACL I lose just by 141 msec to 79 msec, and 38 cons
> to 31. I think the yobs sabotaged SBCL to run kennycode slower.
>
> I am working on a destructive version now, see if I can get it down to 9
> conses. Beats working. :)
11 cons cells :(
(defun ntree-ify (data)
(flet ((nlist-tree-1 (x)
(rplacd x (list (cdr x)))
x))
(loop for lists = data then (cdr lists)
for first = (car lists)
while first
when (third first) ;; untreed and needs tree-ing
do (nlist-tree-1 first)
(loop for rest-1 in (cdr lists)
when (eq (car first) (car rest-1))
do (delete rest-1 lists)
(push (cdr rest-1) (cdr first))
finally (ntree-ify (cdr first))))))
Should be insanely fast on repeated runs. :)
n.b.: Not sure that actually works in all cases, and I keep thinking the
loop could be simplified, but I am leery of letting loop manage state
since I am modifying the structure over which I am explicitly iterating.
Hence no (loop for (first . rest) in lists...
kxo
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <A7cXh.1314$pz1.870@newsfe12.lga>
Ken Tilton wrote:
>
>
> Ken Tilton wrote:
>
>> I am working on a destructive version now, see if I can get it down to
>> 9 conses. Beats working. :)
>
>
> 11 cons cells :(
>
> (defun ntree-ify (data)
> (flet ((nlist-tree-1 (x)
> (rplacd x (list (cdr x)))
> x))
> (loop for lists = data then (cdr lists)
> for first = (car lists)
> while first
> when (third first) ;; untreed and needs tree-ing
> do (nlist-tree-1 first)
> (loop for rest-1 in (cdr lists)
> when (eq (car first) (car rest-1))
> do (delete rest-1 lists)
> (push (cdr rest-1) (cdr first))
> finally (ntree-ify (cdr first))))))
>
>
Just noticed the second use of the flet has gone away, so why bother:
(defun ntree-ify (data)
(loop for lists = data then (cdr lists)
for first = (car lists)
while first
when (third first)
do (rplacd first (list (cdr first)))
(loop for rest-1 in (cdr lists)
when (eq (car first) (car rest-1))
do (delete rest-1 lists)
(push (cdr rest-1) (cdr first))
finally (ntree-ify (cdr first)))))
It is starting to look as simple as I suspected it must be.
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <a8eXh.149$kT7.54@newsfe12.lga>
Madhu wrote:
> * Ken Tilton <··················@newsfe12.lga> :
> |
> | Just noticed the second use of the flet has gone away, so why bother:
> |
> [...]
> | It is starting to look as simple as I suspected it must be.
>
> I think you are making good progress and finally converging to the
> program posted by nallen (and myself), but still using delete and
> consing way more!
We will give you some remedial arithmetic training below, but ... oh,
ok, you do not like delete because we can avoid traversing the list if
we just do cdr splicing? I got lazy. But I think that is why my code
looks so much better than yours. :)
>
> Maybe you'll get there by tomorrow!
Maybe my destructive version (which was not allowed by the spec, which
is why you got disqualified <g>) will have propagated to your news
server by tomoroow. :) Oh, sorry, you were replying to that. Hmmm. What
part of (< 11 18) -> t do you not understand? :)
Currently the standings are:
1. Kenny (destructive) 11 cons cells
2. Madhu 18 cons cells
3. NAllen 31 cons cells
4. Alan C. 35 cons cells
5. Kenny (non-destructive) 38 cells
I was joking, btw, I did not stop to figure out if other code was
destructive. Call me lazy, you won't be wrong.
btw2, I recounted, the switch from flat to tree /does/ require 11 new
conses, not the nine I originally (mis)counted.
So I win, tho others could tie. But can it be done in 11 conses without
writing the same code I wrote?
And I must apologize, I post these exercises but can be a little spotty
in staring at the responses. In this case you did not advertise the 18
cells (vs my 38) so I did not look closer.
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
From: Ken Tilton
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <ghmXh.238$kT7.74@newsfe12.lga>
Madhu wrote:
> * Ken Tilton <················@newsfe12.lga> :
> Well, I was just pointing out that control flow of the programs seemed
> to be getting closer, converging in their sequence of operations..
The next question is, Why are they converging? Is it because we are
looking at each other's code, or is the problem a strange attractor,
drawing everyone to the same code?
>
> [...]
>
> |Currently the standings are:
> |1. Kenny (destructive) 11 cons cells
> |2. Madhu 18 cons cells
> |3. NAllen 31 cons cells
> |4. Alan C. 35 cons cells
> |5. Kenny (non-destructive) 38 cells
>
> I was not sure how you were getting these numbers.
ACL's time macro.
> But since we all
> seem to have wasted time on TIMING these things,
Or is this the strange attractor drawing the code in the right
direction? The odd thing is that at first the destructive version looked
horrific, then it occurred to me to use delete so I would not have to do
explicit cdr tweaking, and how the optimized version looks pretty
obvious as code goes, more so than the non-destructive version which is
supposed to be simpler.
kt
--
http://www.theoryyalgebra.com/
"Algebra is the metaphysics of arithmetic." - John Ray
"As long as algebra is taught in school,
there will be prayer in school." - Cokie Roberts
"Stand firm in your refusal to remain conscious during algebra."
- Fran Lebowitz
"I'm an algebra liar. I figure two good lies make a positive."
- Tim Allen
From: Madhu
Subject: Re: Another "gotta be a better way" from <gasp> The Real World of Lisp
Date:
Message-ID: <m3647ntmcn.fsf@robolove.meer.net>
* Ken Tilton <··············@newsfe12.lga> :
| 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):
As Rob Warnock noted, it is hard to come up with a different algorithm.
However it is impossible to resist submitting a <spit> tail-recursive solution
which conses little. Also to demonstrate the clever use of docstring in
making the whole thing "perspicuous".
(defun treeify (lists)
"Set-up: we have traversed a GUI data form and come up with the data to be
written out, in a manner to be specified next. We want output to be orthogonal
to view, so any field is free to return (here comes the manner) a list whose
last item is the field data and everything up to that is understood to be a
path of names down some schema tree (again, orthogonal to the form tree) to
the data, the last path item being thus a ``field name'' and everything above
it being nested group/structures. Corrollary: no path can be both a
field (have data) and also a group with substructure. Finally, we must allow
for one form to specify multiple data trees, ie, multiple roots."
(labels ((add-to-trie (trie path &optional parent root)
(let ((cons (assoc (car path) trie)))
(cond ((endp (cddr path))
(if cons (setf (cdr cons) (cdr path)) (push path trie))
(when parent (setf (cdr parent) trie)) (or root trie))
(t (unless cons
(setq cons (cons (car path) nil))
(push cons trie))
(when parent (setf (cdr parent) trie))
(add-to-trie (cdr cons) (cdr path)
cons (or root trie)))))))
(reduce #'add-to-trie (cons nil lists))))
The non-tail-recursive version may be better (for TIME):
(defun add-to-trie (trie path)
(let ((cons (assoc (car path) trie)))
(if (endp (cddr path))
(cond (cons (setf (cdr cons) (cdr path)) trie)
(t (cons path trie)))
(let ((value (add-to-trie (cdr cons) (cdr path))))
(cond (cons (setf (cdr cons) value) trie)
(t (cons (cons (car path) value) trie)))))))
--
Madhu