Topic: Binary Tree Algorithm

[udaaf]

Thanks irned,
saved me from translating some Python code I wrote a couple of months ago.
I'll go watch the football instead

udaaf
Looks like you're well on your way now.

@Kerry,
Yes, Of course 

[JohnK]

John,
The tree is simply an ordered Tree using a Universal Address System : 
...
http://csis.bits-pilani.ac.in/faculty/nirmal/dscs/Intro_Trees.pdf

Whoa?! Damn near a forest of trees. I need to do some reading! Thank you.

[JohnK]

You get many different flavours of trees. What you're referring to here is specifically called a Binary Search Tree.
...

Thanks for the links! ...Off to read.

[reltro]

Hey...
Im not sure if the following Routines are usefull to build a binary tree, but they build a tree
Just try it out...

They work recursivly, but anonym recursiv...
(without vl-....)

Code: [Select]

(setq setter
     (    (lambda (setter /)
               (eval (list 'lambda '(data key newValue / ) (list setter setter 'data 'key 'newValue)))
          )
          (lambda (setter data key newValue / )
               (cond
                    ((and (listp data) (not (and (atom (cdr data)) (not (null (cdr data))))) (apply 'and (mapcar 'listp data)))
                         (     (lambda (subdata otherdata / )
                                   (cond
                                        ((and (null (cdr key)) newValue)
                                             (cons (list (car key) newValue) otherdata)
                                        )
                                        ((and (null (cdr key)) (null newValue)) otherdata)
                                        ('T
                                             (     (lambda (rec / )
                                                       (if rec
                                                            (cons (list (car key) rec) otherdata)
                                                            otherdata
                                                       )
                                                  )
                                                  (setter setter subdata (cdr key) newValue)
                                             )
                                        )
                                   )
                              )
                              (cadr (assoc (car key) data))
                              (     (lambda (nose tail / )
                                        (repeat (length tail) (setq nose (cdr nose)))
                                        (append (cdr tail) (reverse nose))
                                   )
                                   (reverse data)
                                   (member (assoc (car key) data) data)
                              )
                         )
                    )
                    ('T (if newValue
                              (list
                                   (list
                                        (car key)
                                        (     (lambda (k / )
                                                  (while k
                                                       (setq newValue (list (cons (car k) (list newValue))))
                                                       (setq k (cdr k))
                                                  )
                                                  newValue
                                             )
                                             (reverse (cdr key))
                                        )
                                   )
                              )
                         )
                    )
               )
          )
     )
)
;-------------------------------------------------
(setq getter
     (    (lambda (getter / )
               (eval (list 'lambda '(data key / ) (list getter getter 'data 'key)))
          )
          (lambda (getter data key / )
               (cond
                    ((and (listp data) (not (and (atom (cdr data)) (not (null (cdr data))))) (apply 'and (mapcar 'listp data)))
                         (     (lambda (subdata / )
                                   (if (null (cdr key)) subdata
                                        (getter getter subdata (cdr key))
                                   )
                              )
                              (cadr (assoc (car key) data))
                         )
                    )
                    ('T  data)
               )
          )
     )
)

Usage:

(setq DataBase (setter nil '(1 2 3 4) "DataItem"))
;-> ((1 ((2 ((3 ((4 "DataItem"))))))))

(setq DataBase (setter DataBase '(1 2 3 5) "DataItem2"))
;-> ((1 ((2 ((3 ((5 "DataItem2") (4 "DataItem"))))))))

(setq DataBase (setter DataBase '(1 2 2) "DataItem3"))
;-> ((1 ((2 ((2 "DataItem3") (3 ((5 "DataItem2") (4 "DataItem"))))))))

;;toRemove a DataItem
(setq DataBase (setter DataBase '(1 2 3 4) nil))
;-> ((1 ((2 ((3 ((5 "DataItem2"))) (2 "DataItem3"))))))

;; and the 'getter' Function
(getter DataBase '(1 2 2))
;-> "DataItem3"

greets reltro

[Kerry]

reltro,
Just for interest, which language did you work with before using AutoLisp ??

...
and why do use double parenthesis for the result ?
added: I see what you did now.

[reltro]

Hey Kerry...
Autolisp was the firts language I learned...

I don't work as a programmer, so I don't know/understand the benefits of a binarytree... Im studing architecture...

I use double parenthesis because someone told me that for Example '(1 2 . 2) is not a valid Data in AutoLisp...
This one came up if u want to Store a dotteddPair, u know: (cons 1 '(2 . 2))


For this task:

Code: [Select]

(setq MakeTree
     (lambda (indexLst Datalst / DataBase)
          (foreach i      (mapcar
                              '(lambda (index DataItem / )
                                   (list
                                        (read (strcat "(" (vl-string-translate "." " " index) ")"))
                                        DataItem
                                   )
                              )
                              indexLst
                              Datalst
                         )
               (setq DataBase (apply 'setter (cons DataBase i)))
          )
     )
)
(setq GetFromIndex (lambda (DataBase Index / ) (getter DataBase (read (strcat "(" (vl-string-translate "." " " index) ")")))))



Code: [Select]

(setq Tree
(MakeTree
'("0" "1" "1.1" "2" "2.1" "2.1.1" "2.1.2" "2.1.2.1" "2.1.2.2" "2.2" "3" "3.1" "3.1.1" "3.1.2")
'("M1" "S1" "P1" "S2" "P2" "P5" "P6" "P9" "P0" "P3" "S3" "P4" "P7" "P8")
)
)

;-> ((3 ((1 ((2 "P8") (1 "P7"))))) (2 ((2 "P3") (1 ((2 ((2 "P0") (1 "P9"))) (1 "P5"))))) (1 ((1 "P1"))) (0 "M1"))

(getFromIndex Tree "2.1.2.1")

irneb:
;(read (strcat "(" (vl-string-translate "." " " index) ")"))
this is so nice

greets

[Kerry]

You will need to have another look at your routine ... all values are not in the tree.

[reltro]

Oh, ur right... Thanks Kerry

I don't wrote the routines for this thread...
I don't tought about this, because I use it in an other way...

to refer to a binaryTree I can store Data only in a leaf...

Will build an other Version soon...

[irneb]

irneb:
;(read (strcat "(" (vl-string-translate "." " " index) ")"))
this is so nice

I can't take the credit entirely, I saw this principle from some other threads a long time ago. Just can't remember which. It was probably one of the parsing strings (like in reading a CSV file).

I try to make my code as simple as possible. Though I'm still not as good at it as some others here. E.g. that nested mapcar thread is a place where Lee beat me at simplicity as well as performance That is actually very close to the traversing functions in this thread, at least related.

[reltro]

Kerry,
the 'new' Version:

WithOut vl-...

Code: [Select]

(apply
   '(lambda (ParseIndex setter getter / )
      (list
         (eval
            (list 'defun 'Tree:make '(IndexLst DataLst / )
               (list
                  (lambda (ParseIndex setter / Tree)
                     (mapcar '(lambda (i d / ) (setq Tree (setter Tree (ParseIndex i) d))) IndexLst DataLst)
                     Tree
                  )
                  ParseIndex
                  setter
               )
            )
         )
         (eval (list 'defun 'Tree:get '(Tree Index / ) (list getter 'Tree (list ParseIndex 'Index))))
         (eval (list 'defun 'Tree:set '(Tree Index Value / ) (list setter 'Tree (list ParseIndex 'Index) 'Value)))
      )
   )
   (list
      (lambda (Index / )
         (mapcar 'read
            (   (lambda (str sep / tmp Out)
                  (if (= sep "")
                     (   (lambda (str / res i)
                           (setq i 0)
                           (reverse (repeat (strlen str) (setq res (cons (substr str (setq i (1+ i)) 1) res))))
                        )
                        str
                     )
                     (progn
                        (setq tmp "")
                        (while (not (= str ""))
                           (if (eq (substr str 1 (strlen sep)) sep)
                              (setq    Out      (cons tmp Out)
                                    str      (substr str (strlen sep))
                                    tmp      ""
                              )
                              (setq tmp (strcat tmp (substr str 1 1)))
                           )
                           (setq str (substr str 2))
                        )
                        (reverse (cons tmp Out))
                     )
                  )
               )
               Index
               "."
            )
         )
      )
      ;-------------------------------------------------
      (   (lambda (setter / ) (eval (list 'lambda '(Tree Index Value / ) (list setter setter 'Tree 'Index 'Value))))
         (lambda (setter Tree Index Value / subdata i res remove)
            (if   (and Tree (setq subdata (assoc (car Index) Tree)))
               (progn
                  (setq remove (lambda (toRemove from / res) (reverse (foreach i from (if (not (equal toRemove i))(setq res (cons i res)))))))
                  (if (cdr Index)
                     (remove
                        nil
                        (mapcar
                           '(lambda (a / ) (if (and (null (cadr a)) (null (caddr a))) nil a))
                           (subst
                              (list
                                 (car subdata)
                                 (cadr subdata)
                                 (setter setter (caddr subdata) (cdr Index) Value)
                              )
                              subdata
                              Tree
                           )
                        )
                     )
                     (if (or Value (caddr subdata))
                        (subst
                           (cons (car subdata) (cons Value (cddr subdata)))
                           subdata
                           Tree
                        )
                        (remove subdata Tree)
                     )
                  )
               )
               (if Value
                  (cons
                     (repeat (length (setq Index (reverse Index)))
                        (setq res
                           (list
                              (nth (if i i (setq i 0)) Index)
                              (if (= (setq i (1+ i)) 1) Value)
                              (if res (list res) nil)
                           )
                        )
                     )
                     Tree
                  )
                  Tree
               )
            )
         )
      )
      ;-------------------------------------------------
      (lambda (Tree Index / )
         (while Index
            (setq Tree
               (   (lambda (res / )
                     (if (setq Index (cdr Index))
                        (caddr res)
                        (cadr res)
                     )
                  )
                  (assoc (car Index) Tree)
               )
            )
         )
      )
   )
)
With vl-remove , vl-remove-if-not , vl-string-translate

Code: [Select]

(apply
   '(lambda (ParseIndex setter getter / )
      (list
         (eval
            (list 'defun 'Tree:make '(IndexLst DataLst / )
               (list
                  (lambda (ParseIndex setter / Tree)
                     (mapcar '(lambda (i d / ) (setq Tree (setter Tree (ParseIndex i) d))) IndexLst DataLst)
                     Tree
                  )
                  ParseIndex
                  setter
               )
            )
         )
         (eval (list 'defun 'Tree:get '(Tree Index / ) (list getter 'Tree (list ParseIndex 'Index))))
         (eval (list 'defun 'Tree:set '(Tree Index Value / ) (list setter 'Tree (list ParseIndex 'Index) 'Value)))
      )
   )
   (list
      (lambda (Index / ) (read (strcat "(" (vl-string-translate "." " " index) ")")))
      ;-------------------------------------------------
      (   (lambda (setter / )
            (eval (list 'lambda '(Tree Index Value / ) (list setter setter 'Tree 'Index 'Value)))
         )
         (lambda (setter Tree Index Value / subdata i res)
            (if   (and Tree (setq subdata (assoc (car Index) Tree)))
               (if (cdr Index)
                  (vl-remove-if-not
                     '(lambda (a / ) (or (cadr a) (caddr a)))
                     (subst
                        (list
                           (car subdata)
                           (cadr subdata)
                           (setter setter (caddr subdata) (cdr Index) Value)
                        )
                        subdata
                        Tree
                     )
                  )
                  (if (or Value (caddr subdata))
                     (subst
                        (cons (car subdata) (cons Value (cddr subdata)))
                        subdata
                        Tree
                     )
                     (vl-remove subdata Tree)
                  )
               )
               (if Value
                  (cons
                     (repeat (length (setq Index (reverse Index)))
                        (setq res
                           (list
                              (nth (if i i (setq i 0)) Index)
                              (if (= (setq i (1+ i)) 1) Value)
                              (if res (list res) nil)
                           )
                        )
                     )
                     Tree
                  )
                  Tree
               )
            )
         )
      )
      ;-------------------------------------------------
      (lambda (Tree Index / )
         (while Index
            (setq Tree
               (   (lambda (res / )
                     (if (setq Index (cdr Index))
                        (caddr res)
                        (cadr res)
                     )
                  )
                  (assoc (car Index) Tree)
               )
            )
         )
      )
   )
)

(setq Tree
  (Tree:Make
    '("0" "1" "1.1" "2" "2.1" "2.1.1" "2.1.2" "2.1.2.1" "2.1.2.2" "2.2" "3" "3.1" "3.1.1" "3.1.2")
    '("M1" "S1" "P1" "S2" "P2" "P5" "P6" "P9" "P0" "P3" "S3" "P4" "P7" "P8")
  )
)

;; -> ((3 "S3" ((1 "P4" ((2 "P8" nil) (1 "P7" nil))))) (2 "S2" ((2 "P3" nil) (1 "P2" ((2 "P6" ((2 "P0" nil) (1 "P9" nil))) (1 "P5" nil))))) (1 "S1" ((1 "P1" nil))) (0 "M1" nil))


(Tree:Get Tree "2.1.1") ;;-> "P5"

(setq tree (Tree:Set Tree "2.1.1" "hello"))

(Tree:Get Tree "2.1.1") ;;-> "hello"

greets reltro

[reltro]

Here is an other Version:

I found out that the double parenthesis don't make any sense in this case, so I built one without them...

Code: [Select]

(   (lambda (setter getter / ParseIndex tmp)
      (setq ParseIndex (lambda (Index / ) (read (strcat "(" (vl-string-translate "." " " (vl-princ-to-string Index)) ")"))))
     
      (list
         ;---------------
         (eval
            (list 'defun 'Tree:Get '(Tree Index / )
               (list
                  (lambda (getter ParseIndex / )
                     (setq Index (ParseIndex Index))
                     (cond
                        ((= (type Tree) 'SYM) (getter (eval Tree) Index))
                        ((getter Tree Index))
                     )
                  )
                  getter
                  ParseIndex
               )
            )
         )
         ;---------------
         (setq tmp
            (eval
               (list 'defun 'Tree:Set '(Tree Index Value / )
                  (list
                     (lambda (setter ParseIndex / )
                        (setq Index (ParseIndex Index))
                        (cond
                           ((= (type Tree) 'SYM) (set Tree (setter setter (eval Tree) Index Value)))
                           ((setter setter Tree Index Value))
                        )
                     )
                     setter
                     ParseIndex
                  )
               )
            )
         )
         ;---------------
         (eval
            (list 'defun 'Tree:Make '(IndexLst DataLst / )
               (list
                  (lambda (setter / Tree)
                     (mapcar
                        '(lambda (i d / ) (setq Tree (setter Tree i d)))
                        IndexLst
                        DataLst
                     )
                     Tree
                  )
                  tmp
               )
            )
         )
      )
   )
   ;---------------
   (lambda (setter Tree Index Value / subdata res i)
      (if   (and Tree (setq subdata (assoc (car Index) Tree)))
         (if (cdr Index)
            (vl-remove-if-not
               '(lambda (a / ) (or (cadr a) (cddr a)))
               (subst
                  (vl-list* (car subdata) (cadr subdata) (setter setter (cddr subdata) (cdr Index) Value))
                  subdata
                  Tree
               )
            )
            (if (or Value (cddr subdata))
               (subst
                  (vl-list* (car subdata) Value (cddr subdata))
                  subdata
                  Tree
               )
               (vl-remove subdata Tree)
            )
         )
         (if Value
            (cons
               (repeat (length (setq Index (reverse Index)))
                  (setq res
                     (cond
                        (i (setq i (1+ i)) (list (nth i Index) nil res))
                        ((setq i 0) (list (nth i Index) Value))
                     )
                  )
               )
               Tree
            )
            Tree
         )
      )
   )
   ;---------------
   (lambda (Tree Index / )
      (while Index
         (setq Tree
            (   (lambda (res / )
                  (if (setq Index (cdr Index))
                     (cddr res)
                     (cadr res)
                  )
               )
               (assoc (car Index) Tree)
            )
         )
      )
   )
)

I also added some other 'feature' in the "Tree:set"-Method:
If the Tree is given as a Symbol, the Routine will set the new Data for Tree directly.

(Tree:set 'MyTree "1.2.3" "hello")
OR
(setq MyTree (Tree:set MyTree "1.2.3" "helloWorld")

Greets

[irneb]

Just as an extra over, here's the traverse-breadth-first:

Code - Auto/Visual Lisp: [Select]

1. (defun enqueue (source item)
2.   (set source (cons item (eval source)))
3.   item)
4.  
5. (defun dequeue (source / item)
6.   (setq item (car (set source (reverse (eval source)))))
7.   (set source (reverse (cdr (eval source))))
8.   item)
9.  
10. (defun Tree:Breadth-First-Traverse (tree visit / queue node)
11.   (enqueue 'queue tree)
12.   (while queue
13.     (apply visit (list (Tree:GetValue (setq node (dequeue 'queue)))))
14.     (foreach item (cdr node) (enqueue 'queue item))))

I'm using the algorithm from here: http://en.wikipedia.org/wiki/Tree_traversal#Breadth-first_2

Thus the queue data structure as a helper.

[udaaf]

@Irneb,

I'm back again after trying for learn your code. Actually your code is very hard for understood  .

I have try for parse the text index become

Code: [Select]

((0) (1) (2) (3) (3 1) (3 2) (3 3))With this one :

Code: [Select]

(setq testData '("M-001" "P-001" "P-002" "SU-001" "P-001" "P-002" "P-003")
      testIndex '("0" "1" "2" "3" "3.1" "3.2" "3.3"))
(setq i 0)
(setq index nil)
(repeat (length testIndex)
  (setq TempIndex (read (strcat "("(vl-string-translate "." " " (nth i testIndex))")")))
  (setq index (cons TempIndex index))
  (setq i (1+ i))
  )
(setq ParseIndex (reverse index))

and then I'm try for breakdown this function :

Code: [Select]

(defun Tree:SetValueAtIndex (tree index value / doSet)
  (defun doSet (tree index / tmp)
    (cond ((or (not index) (= index 0)) (cons value (cdr tree)))
          ((atom index)
           (repeat index (setq tmp (cons (car tree) tmp) tree (cdr tree)))
           (append (reverse tmp) (list (doSet (car tree) nil)) (cdr tree)))
          ((= (length index) 1) (doSet tree (car index)))
          (t
           (repeat (car index) (setq tmp (cons (car tree) tmp) tree (cdr tree)))
           (append (reverse tmp) (list (doSet (car tree) (cdr index))) (cdr tree)))))
  (doSet tree index))
I can't understand how to fill variable tree & index the code above.
Can you explain me please 
 

[Kerry]

@udaaf,
Start with a shorter list and step through the code in the debugger in the VLIDE.

[udaaf]

@Kerry,

Thanks for your suggestion.
I had try with shorter list and debugging in VLIDE. But still can't understand Irneb code. Especially for function Tree:SetValueAtIndex and doSet. Where this function get variable for tree + index + value.
So that's why I try create new code for understand the logic.