Δυαδικό Δένδρο (Διαγραφή στοιχείου)

Εδώ είναι η πρώτη δημοσίευση χωρίς τη διαγραφή.

Η διαγραφή στοιχείου είναι το δυσκολότερο κομμάτι, επειδή έχει μια σειρά από περιπτώσεις. Πάλι εδώ έχω χρησιμοποιήσει SUB (Ρουτίνα). Ο κώδικας είναι στα αγγλικά (η Μ2000 έχει εντολές και στα αγγλικά).
Πρώτα πρέπει να βρεθεί το στοιχείο που θέλουμε να σβήσουμε. Αυτό γίνεται με μια function (συνάρτηση) που έχει δικά του Subs (ρουτίνες). Η χρήση των ρουτινών γίνεται για πολλούς λόγους, ένας από αυτούς είναι ότι έχουν μεγάλο όριο αναδρομής. Στις ρουτίνες μπορούμε να έχουμε τοπικές μεταβλητές, και με αναφορά περασμένες. Αν καλέσει η ρουτίνα τον εαυτό της τότε φτιάχνει νέα σειρά τοπικών μεταβλητών, μπορεί μάλιστα να περνάμε και μεταβλητές με αναφορές. αλλά όχι πίνακες με αναφορές- αυτό μάλλον είναι bug θα το εξετάσω να δω γιατί δεν το έχω αφήσει ..ελεύθερο. Πάντως μπορούμε έναν πίνακα ή κάποια μεταβλητή να την βλέπουμε μέσα από την ρουτίνα χωρίς να την περάσουμε με αναφορά, επειδή οι ρουτίνες δεν έχουν "namespace" αλλά δανείζονται αυτό του τμήματος που βρίσκονται, δηλαδή εκτελούμε κώδικα στο τμήμα, άρα βλέπουμε ότι έχει αυτό. Η εντολή Local δημιουργεί τοπικές μεταβλητές ώστε να κρύψουμε (ή σκιάσουμε) μεταβλητές με ίδιο όνομα στο τμήμα. Αν δεν το κάνουμε μια ι=10 θα αλλάξει τιμή στη ι αν η ι υπάρχει στο τμήμα.  Μπορούμε να φτιάξουμε μια μεταβλητή και να καλέσουμε μια άλλη ρουτίνα χωρίς να την περάσουμε και να την διαβάζουμε εκεί! Γενικά έχουμε μεγάλη ελευθερία με τις ρουτίνες.

Στο παράδειγμα έχουμε και σε συνάρτηση ρουτίνες, για να αποφύγουμε την αναδρομή σε συνάρτηση!

Form 80,40
Recursion.limit 100000
Gosub Myclass  ' define Mem() class function
Class mTree2 {
      item
      pLeft=-1
      pRight=-1
}
Function FindMinNode {
      Read &Tree, Root
      If Match("N") Then { Read Ok } Else Clear Ok
      Dim Ret(2)
      Ret(0):=Tree.Null(), Root
      pleft=Tree.d(root).pright
      While pleft<>Tree.Null() {Ret(1)=Ret(0): Ret(0)=pleft : pleft=.Tree.d(pleft).pleft}
      If Ok Then {
            If Ret(1)=Tree.Null() Then Ret(1)=Root
            =Ret()    \\ return array
      } Else {
            =Ret(0)
      }
}
Function FindNode {
      Read &Tree, Root, Item
      If Match("N") Then { Read Ok } Else Clear Ok
      Dim Ret(2)
      Ret(0):=Tree.Null(), Root
      Find(&Root, Item)
      If Ok Then {
            =Ret()    \\ return array
      } Else {
            =Ret(0)
      }
      \\ we make a subrutine for maximum recursion
      \\ functions allow 128 calls (use system stack)
      \\ subs recursion are limmited by Recursion.Limit (use special stack)
      Sub Find(&Root, item)
            If valid(r$) Else r$="Tree.d(Root)"     
            If item<Eval(r$.item) Then FindLeft(&Root, item) :Exit Sub
            If item=Eval(r$.item) Then Ret(0)=Root : Exit Sub
            Ret(1)=root
            Local pright=Eval(r$.pright)
            If pright<>Tree.NULL() Then Find(&pright,item)
      End Sub     
      Sub FindLeft(&Root, Item)
            Ret(1)=Root
            Local pleft=Eval(r$.pleft)
            If pleft<>Tree.NULL() Then Find(&pleft,item) 
      End Sub
}
Clear TreeOne
M=Mem(100)
MakeTree(&TreeOne,5)
Insert(&TreeOne,8)
Insert(&TreeOne,4)
Insert(&TreeOne,3)
Insert(&TreeOne,10)
Insert(&TreeOne,7)
\\Print TreeOne
Disp(TreeOne)
Stack New {
      Data 5,8,4,3,7,10,800
      While Not Empty { 
      Read num
      Report Format$("Find item {0} at Mem Handler: {1}", num, FindNode(&M, TreeOne, num))
      }
}
Dim re()
rr=8
\\ using true as 4th parameter we get an array - two parameters
re()=FindNode(&M, TreeOne, rr, true)
Report Format$("{0} is in array item:{1} With Root array item:{2} with item {3}",rr,re(0),re(1), m.d(re(1)).item)
Print "Disp DFS"
If Treeone<>M.Null() Then { DispDFS(TreeOne) } Else Print "Empty"
Stack New {
      Data 5,4,10,3,-14,-2,7,800,8
      While Not Empty { 
      Read num
      if num<0 then {
            Insert(&TreeOne,abs(num))
            If Treeone<>M.Null() Then { Print "Insert ";abs(Num);" Display" : Disp(TreeOne) } Else Print "Empty"
      } else {
            Delete(&TreeOne, num)      
            If Treeone<>M.Null() Then { Print "Delete ";Num;" Display" : Disp(TreeOne) } Else Print "Empty"
      }
      Report 2, "Press any key"
      aa$=Key$
      }
}
Print "Disp DFS"
If Treeone<>M.Null() Then { DispDFS(TreeOne) } Else Print "Empty"
End
Sub Delete(&Root, item)
      Dim resp()
      \\ resp(0) is pointer to item to delete, And resp(1) is parent of resp(0)
      resp()=FindNode(&M, Root, Item, true)
      If resp(0)=M.Null() Then Exit Sub
      If resp(0)=Root And M.count=1 Then  {
            M.MFree resp(0)
            Root=M.Null()
            Exit Sub
      }
      Local isleft
      \\ we need to know from where parent..has this child
      isleft=M.d(resp(1)).pleft=resp(0)
      \\ is it a lonly child
      If M.d(resp(0)).pleft=M.Null() And M.d(resp(0)).pright=M.Null() Then {
            \\ no childs just remove it
            M.MFree resp(0)
            If isleft Then { M.d(resp(1)).pleft=M.Null() } Else  M.d(resp(1)).pright=M.Null()
            Exit Sub 
      }
      \\ is it a rich child (with two childs)
      If  M.d(resp(0)).pleft<>M.Null() And  M.d(resp(0)).pright<>M.Null() Then {
            Dim resp2()
            resp2()=FindMinNode(&M,resp(0), True)
            \\ We make a swap, 
            For M.d(resp(0)), M.d(resp2(0)) {
                  Swap .item, ..item
            }
            If M.d(resp2(1)).pright=resp2(0) Then {M.d(resp2(1)).pright=M.d(resp2(0)).pright } Else M.d(resp2(1)).pLeft=M.Null()
            M.MFree resp2(0)
            Exit Sub
      }
      If  M.d(resp(0)).pleft=M.Null() Then {
            If resp(0)=Root Then {
                  Root=M.d(resp(0)).pright
            } Else {
                  If isleft Then { M.d(resp(1)).pleft=M.d(resp(0)).pright } Else  M.d(resp(1)).pright=M.d(resp(0)).pright
            }
            M.MFree resp(0)
            Exit Sub
      }
      If resp(0)=Root Then {
            Root=M.d(resp(0)).pleft
      } Else {
            If isleft Then { M.d(resp(1)).pleft=M.d(resp(0)).pleft } Else  M.d(resp(1)).pright=M.d(resp(0)).pleft
      }
      M.MFree resp(0) 
End Sub
Sub Insert(&Root, item)
      \ using no blocks { } we have maximum recursion
      If Root=m.NULL() Then PlaceOne(&Root, &item) : Exit Sub
      If valid(r$) Else r$="m.d(Root)"     
      If valid(k$) Else k$="m.d(kk)"     
      If item<Eval(r$.item) Then CheckLeft(&Root, &item) :Exit Sub
      Local pright=Eval(r$.pright)
      If pright<>m.NULL() Then Insert(&pright,item) : r$.pright=pright : Exit Sub
      Local kk=m.Malloc(mTree2())  
      r$.pright=kk
      k$.item=item
End Sub
Sub MakeTree(&Root, item)
      r$="m.d(Root)"
      PlaceOne(&Root, &item)
End Sub
Sub PlaceOne(&Root, &item)
      Root=m.Malloc(mTree2())  
      r$.item=item
End Sub
Sub CheckLeft(&Root, &Item)
      Local pleft=Eval(r$.pleft)
      If pleft<>m.NULL() Then Insert(&pleft,item) : r$.pleft=pleft : Exit Sub
      Local kk=m.Malloc(mTree2())  
      r$.pleft=kk
      k$.item=item
End Sub
Sub Disp(walk)
      If walk<>m.Null() Then Print m.property(walk,"item")
      If m.property(walk,"pLeft")<>m.Null() Then Print "L=";m.property(m.property(walk,"pLeft"),"item") 
      If m.property(walk,"pRight")<>m.Null() Then Print "R=";m.property(m.property(walk,"pRight"),"item")
      If m.property(walk,"pLeft")<>m.Null() Then Disp(m.property(walk,"pLeft"))
      If m.property(walk,"pRight")<>m.Null() Then Disp(m.property(walk,"pRight"))
End Sub
Sub DispDFS(walk)
      If m.property(walk,"pLeft")<>m.Null() Then DispDFS(m.property(walk,"pLeft"))
      Print m.property(walk,"item")
      If m.property(walk,"pRight")<>m.Null() Then DispDFS(m.property(walk,"pRight"))
End Sub
MyClass:
Class Mem {
      Dim d()
      noUsed=-1
      topfree=0
      Items, Count
      Group Null { Null }
      Function Null {
            =-1
      }
      Function IsNull {
            =Valid(.d(Number).Null)
      }
      Module Mem {
            Read .Items
            If Match("G") Then Read N
            N=.Null   \\ this is a Union If N is a Group
            Dim .d(.Items)=N
      }
      Function Malloc { 
            If .noUsed=-1 Then {
                  If .topfree<.Items Then {      
                        Read .d(.topfree)
                        =.topfree
                        .topfree++
                        .count++
                  } Else Error "Memory Full"
            } Else {
                  temp=.d(.noUsed).Null
                  Read .d(.noUsed)
                  =.noUsed
                  .noUsed<=temp
                  .count++
            } 
      }
      Module Mfree {
            Read mf
            If .IsNull(mf) Then Error "Invalid Pointer"
            old=.noUsed
           .noUsed<=mf
           .d(mf)=.Null
           .d(mf).Null<=old
           .count--
      }
      Function Property {
            Read A, A$
            A$=".d(A)."+A$  ' M2000 has pointers, showing absolute/relative position
            If .IsNull(A) Then  Error "Invalid Pointer "+str$(A)
            =Eval(A$)
            If Match("N") Then A$.=Number
      }
      Function Property$ {
            Read A, A$
            A$=".d(A)."+A$
            If .IsNull(A) Then  Error "Invalid Pointer"
            =Eval$(A$.)  ' look . after A$
            \\ A$. is Not A$ is a pointer To 
            If Match("S") Then A$. = letter$
      }
}
Return