(setq SeqNum (list "0" "1" "2" "2.1" "2.2" "2.3"))
;Result
(1 2 4 5 7 9)
(12 3 11 6 8 10)
;OR
((1 12) (2 3) (4 11) (5 6) (7 8) (9 10))
;Fungsi mencari jumlah karakter tertentu pada kumpulan karakter
(defun JumKar (string cari)
(setq counter 0)
(setq i 1)
(repeat (strlen string)
;mencari dan mengambil karakter pada posisi dan jumlah yang akan diambil
;membuang karakter spasi pada saat pencarian
(setq a (substr string i (strlen (setq b (vl-string-trim " " cari)))))
(if (= a b)
(setq counter (1+ counter))
);if
(setq i (1+ i))
);repeat
(setq JumlahKar counter)
);defun
;Fungsi mencari posisi
(defun CarPos (string cari / i tampung posisi)
(setq counter 0)
(setq i 1)
(setq tampung nil)
(repeat (strlen string)
;mencari dan mengambil karakter pada posisi dan jumlah yang akan diambil
;membuang karakter spasi pada saat pencarian
(setq a (substr string i (strlen (setq b (vl-string-trim " " cari)))))
(setq posisi i)
(if (= a b)
(setq tampung (cons posisi tampung))
);if
(setq i (1+ i))
);repeat
(setq posisi (reverse tampung))
);defun
;Cara penggunaan fungsi.
(CARPOS "3.500.67.2" ".")
;-------------------------------------------------
(setq SeqNum (list "0" "1" "2" "2.1" "2.2" "2.3"))
(Setq LenList (length SeqNum))
(setq lft nil
rgt nil
);setq
(setq i 1
j 1
k 1
l 1
m 1
n 1
)
;Fungsi jumlah karakter pada urutan list
(defun CharL (n string)
(strlen (nth n String))
);defun
;Tree
(repeat LenList
(cond
((= i 1)
(progn
(setq lft (cons i lft))
(setq i (1+ i))
);progn
);cond_1
((= (CharL (1- i) SeqNum) (CharL i SeqNum))
(setq lft (cons (* i 2) lft))
(setq lft (cons (+ i 1) lft))
);cond_2
);cond
);repeat
((1 12)
((2 3))
((4 11)
((5 6))
((7 8))
((9 10))
)
)
In this case the 1st item in any node is the data. If the data consists of more than one value, then that 1st item itself is a list.<..>
Are you perhaps referring to a Tree data structure? In that case any node may have 0 through to N sub-nodes. And in Lisp such a structure is nothing other than a set of nested lists.
_$ (setq tree '((1 12) ((2 3)) ((4 11) ((5 6)) ((7 8)) ((9 10)))))
((1 12) ((2 3)) ((4 11) ((5 6)) ((7 8)) ((9 10))))
_$ (Tree:GetValue (Tree:GetFromIndex nil tree))
(1 12)
_$ (Tree:GetValue (Tree:GetFromIndex '(1) tree))
(2 3)
_$ (Tree:GetValue (Tree:GetFromIndex '(2) tree))
(4 11)
_$ (Tree:GetValue (Tree:GetFromIndex '(2 1) tree))
(5 6)
_$ (Tree:GetValue (Tree:GetFromIndex '(2 2) tree))
(7 8)
_$ (Tree:GetValue (Tree:GetFromIndex '(2 3) tree))
(9 10)
_$ (Tree:GetValue (Tree:GetFromIndex 2 tree))
(4 11)
_$ (Tree:GetValue (Tree:GetFromIndex 0 tree))
(1 12)
_$ (Tree:GetValue (Tree:GetFromIndex '(1 0) tree))
(2 3)
_$ (Tree:GetValue (Tree:GetFromIndex '(1) tree))
(2 3)
_$ (Tree:GetValue (Tree:GetFromIndex '(2 0) tree))
(4 11)
_$ (Tree:GetValue (Tree:GetFromIndex '(2 1) tree))
(5 6)
I thought he wanted to build a tree from a simple list ??Code - Auto/Visual Lisp: [Select]
Wouldn't the `tree` variable you have manually constructed be dependant on the data in `SeqNum` ?
Hang on a sec.For the root yes index always 0 and for subnode can > 2
- Is this tree always 0 or 3 subnodes? This seems negative, because your root node only has 2 subnodes, even though the rest seem to have 0 or 3.
Yes always filled with sequence number 2.1 -> 2.2 not 2.3
- Is it always filled? I.e. you wouldn't skip a number, say have 2.1 and 2.3 but not 2.2.
Yes I always fill from the left. If not find subnodes or it's called leaf the number will fill the right position
- If filled, does it also fill from the left? E.g. you'd never have a situation where 1 has no subnodes, but 2 has some. This also seems negative, since your first sample has 1 with 0 nodes, and 2 with 3 nodes.
Sometimes I'll have number 1-1.1-1.1.1-1.1.2-1.2
- Is it balanced? I.e. it's always as flat as it can be made, no situations where you might have a 1.1.1 but 2 doesn't have any subnodes.
[/list]The reason I'm asking is that if all those questions are answered in the negative, then this tree structure is quite complex to build programatically. Many checks to go through in order to place the correct item in the correct level at the correct branch.
udaaf,
The tree is ordered and has a unique naming index for each node.
The nodes can be traversed easily without additional link numbers( the left and right sequence numbers youve used).
Is there a particular reason you want to add the sequence numbers.??
Yes. There is a particular reason for add sequence numbers. Because I wanna to add sequence number into table for query the database
What sort of data do you want to associate with each node ( or edge) ??
It's pointless writing code (other than for just it's acedemic value) without knowing the rules to your problem ...
Regards, Kerry
p.s. :
Keeping in mind that the tree is just a visualisation of the indexing for your data ;
it seems to me that for a lisp solution a nested cons list with each recursive data level represented by a level in the tree may be a viable solution.
This assumed that you have control of the data structure.
The potential problem with the system you propose is that if you add (or remove) sub-assemblies or parts to your tree the left and right links will be forced to change, making maintenance a nightmare.
Refer to the Ordered Tree using a Universal Address System diagram that I posted.
Each vertex with children could be considered a component(sub-assembly) of your assembly( node 0).
Each vertex without children (leaf) would be a part of its parent component.
So your database need only refer to the node index without the additional left and right numbering.
I'll have a look at some code tonight (after 0800 UTC)
Regards, Kerry
Trees are good for fast searching and whatnot so it could be in any order (actually that's all my experience with them is; create a node when you discover an item you want to store and keep adding to the tree as you keep parsing--add nodes; small on the left, and big on the right-).You get many different flavours of trees. What you're referring to here is specifically called a Binary Search Tree (http://en.wikipedia.org/wiki/Binary_search_tree).
Yes. There is a particular reason for add sequence numbers. Because I wanna to add sequence number into table for query the databaseIn that case the #1 data #2 needs to be calculated from a traversal of the tree. Will have to look at that. It would be a form of destructive traversal as each node visited would have to modify that node. It would be a form of pre-order traversal (http://en.wikipedia.org/wiki/Tree_traversal#Pre-order).
The potential problem with the system you propose is that if you add (or remove) sub-assemblies or parts to your tree the left and right links will be forced to change, making maintenance a nightmare.Yep, it means that each time you insert anything into that tree (if it doesn't simply replace an existing node) the entire traversal re-numbering has to be done again. It might be possible to come up with an algorithm to only renumber those nodes which change - potentially halving the average number of changes.
Trees are good for fast searching and whatnot so it could be in any order (actually that's all my experience with them is; create a node when you discover an item you want to store and keep adding to the tree as you keep parsing--add nodes; small on the left, and big on the right-).You get many different flavours of trees. What you're referring to here is specifically called a Binary Search Tree (http://en.wikipedia.org/wiki/Binary_search_tree).
There are even further specializations of that particular type. Look down in that page under the "Optimal binary search trees" heading. One of the flavours of the self-balancing BST (http://en.wikipedia.org/wiki/Self-balancing_binary_search_tree) is actually one of the algorithms I had to create in one of the exams in my 2nd year CS degree (in 1995): Red Black Tree (http://en.wikipedia.org/wiki/Red-black_tree).Yes. There is a particular reason for add sequence numbers. Because I wanna to add sequence number into table for query the databaseIn that case the #1 data #2 needs to be calculated from a traversal of the tree. Will have to look at that. It would be a form of destructive traversal as each node visited would have to modify that node. It would be a form of pre-order traversal (http://en.wikipedia.org/wiki/Tree_traversal#Pre-order).The potential problem with the system you propose is that if you add (or remove) sub-assemblies or parts to your tree the left and right links will be forced to change, making maintenance a nightmare.Yep, it means that each time you insert anything into that tree (if it doesn't simply replace an existing node) the entire traversal re-numbering has to be done again. It might be possible to come up with an algorithm to only renumber those nodes which change - potentially halving the average number of changes.
Here's the code for the pre-order traversal sequencing:Code - Auto/Visual Lisp: [Select]
(Tree:Pre-Order-Traverse-And-Back tree val))) ;| Testing code (setq testData '("Albert" "Bert" "Chuck" "Donna" "Eddie" "Fred") testIndex '("0" "1" "2" "2.1" "2.2" "2.3")) (setq testTree (Tree:Make (mapcar 'Tree:ParseIndex testIndex) testData)) ; Returns ("Albert" ("Bert") ("Chuck" ("Donna") ("Eddie") ("Fred"))) (Tree:GetValue (Tree:GetFromIndex (Tree:ParseIndex "2.2") testTree)) ; Returns "Eddie" (Tree:Pre-Order-Sequence-Index testTree) ; Returns ((1 "Albert" 12) (2 "Bert" 3) (4 "Chuck" 11) (5 "Donna" 6) (7 "Eddie" 8) (9 "Fred" 10)) |;
;| Testing code
(setq testData '("M1" "S1" "P1" "S2" "P2" "P5" "P6" "P9" "P0" "P3" "S3" "P4" "P7" "P8")
testIndex '("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"))
(setq testTree (Tree:Make (mapcar 'Tree:ParseIndex testIndex) testData)) ; Returns ("M1" ("S1" ("P1")) ("S2" ("P2" ("P5") ("P6" ("P9") ("P0"))) ("P3")) ("S3" ("P4" ("P7") ("P8"))))
(Tree:GetValue (Tree:GetFromIndex (Tree:ParseIndex "2.1.2") testTree)) ; Returns "P6"
(Tree:Pre-Order-Sequence-Index testTree) ; Returns ((1 "M1" 28) (2 "S1" 5) (3 "P1" 4) (6 "S2" 19) (7 "P2" 16) (8 "P5" 9) (10 "P6" 15) (11 "P9" 12) (13 "P0" 14) (17 "P3" 18) (20 "S3" 27) (21 "P4" 26) (22 "P7" 23) (24 "P8" 25))
|;
Glad it worked for you. Just note that the code is meant for a generic multi node tree. There's nothing "special" about it as it doesn't enforce stuff like maximum children or balancing at all. You could use it as the base for other types of trees, or you could re-write to implement something like a binary search tree - the principles are very much the same.
That I leave for someone else :wink: You tend to learn more by doing than by seeing. Tip: the trick with trees is to use recursion. It makes life a lot simpler.
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.
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 (http://csis.bits-pilani.ac.in/faculty/nirmal/dscs/Intro_Trees.pdf)
You get many different flavours of trees. What you're referring to here is specifically called a Binary Search Tree (http://en.wikipedia.org/wiki/Binary_search_tree).
...
(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)
)
)
)
)
(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) ")")))))
(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::lol: 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).
;(read (strcat "(" (vl-string-translate "." " " index) ")"))
this is so nice :)
(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)
)
)
)
)
)
)
(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)
)
)
)
)
)
)
( (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)
)
)
)
)
)
((0) (1) (2) (3) (3 1) (3 2) (3 3))
With this one :(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))
(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))