Δυαδικό Δένδρο (Binary Tree) στη Μ2000

Ταξινόμηση με χρήση δυαδικού δένδρου

Δείτε και το πιο προχωρημένο (με διαγραφή στοιχείου) εδώ

Με χρήση της ίδιας κλάσης Mem() όπως αυτή που χρησιμοποιήθηκε στη συνδεδεμένη λίστα θα φτιάξουμε το δυαδικό δένδρο. Στο παράδειγμα θα βάζουμε μερικά νούμερα και θα πάρουμε "άμεσα" το Depth-first search (DFS) ξεκινώντας από αριστερά θα φτάσουμε όσο πιο αριστερά γίνεται και θα δείξουμε αυτό που έχουμε!

Στο παράδειγμα φτιάχνουμε δυο δένδρα στο ίδιο αντικείμενο Μ. Έχω φροντίσει οι ρουτίνες να μην καλούν τον εαυτό τους (αναδρομική κλήση) μέσα από μπλοκ {} γιατί αυτό έχει περιορισμούς στο βάθος της αναδρομής, ενώ χωρίς αυτό το όριο είναι ελεγχόμενο με την ΟΡΙΟ.ΑΝΑΔΡΟΜΗΣ που έχει τιμή 1000 (αλλά άνετα γίνεται και 30000). Το δένδρο που φτιάχνουμε δεν είναι ισορροπημένο. Θα έχουμε κλάδους ασύμμετρους. Αυτό δεν μας ενοχλεί για αυτό που θέλουμε, δηλαδή για την ταξινόμηση.

Προσθήκη:
Η εντολή Gosub (Διαμέσου) είναι προεραιτική αν καλούμε Ρουτίνα με όνομα με παρενθέσεις.
Εδώ η πρώτη είναι απαραίτητη γιατί έχουμε απλή ετικέτα Myclass (τα γράμματα έχουν σημασία ως πεζά ή κεφαλαία, ενώ στις συναρτήσεις, τμήματα, κλάσεις, μεταβλητές δεν έχουν).

Από το Myclass επιστρέφουμε με Return (Επιστροφή). Οι ρουτίνες SUB τερματίζουν με το END SUB ή έκτακτα με το EXIT SUB. Οι ρουτίνες δεν έχουν καταχωρημένο όνομα, και ότι δημιουργείται εντός είναι ορατό παντού στο τμήμα, με τη διαφορά ότι στο τέλος, στην επιστροφή ή στην έξοδο θα χαθεί. Οι παράμετροι στις παρενθέσεις γίνονται Read New δηλαδή διαβάζονται ως νέες μεταβλητές, σκιάζοντας τυχόν ίδιες στο τμήμα.

Με τις νέες αναθεωρήσεις μπορούμε να καλέσουμε με παρόμοιο τρόπο συναρτήσεις με την Call Local, και εκεί θα γράψουμε Read New ή Read Local, για να πάρουμε σε μεταβλητές τιμές. Η κλήση γίνεται πιο γρήγορα, αλλά έχει κόστος μνήμης, γιατί κάθε συνάρτηση και κάθε τμήμα έχουν δικό τους αντικείμενο εκτέλεσης, ενώ οι ρουτίνες είναι "ελαφριές" κατασκευές, δουλεύουν στο ίδιο αντικείμενο εκτέλεσης με αυτό του τμήματος.
Αφαιρέθηκαν τα προαιρετικά Gosub
Το ένα που έμεινε δεν μπορεί να αφαιρεθεί γιατί καλεί ρουτίνα τύπου ετικέτα - επιστροφή. Αυτές οι ρουτίνες είναι στην ουσία όπως της Basic, δεν έχουν όπως αυτές με παραμέτρους την διαγραφή των νέων ορισμών. Οι απλές αυτές ρουτίνες χρησιμοποιούνται για κώδικα που επαναλαμβάνεται, και εδώ για κώδικα που θέλουμε να είναι στο τέλος αλλά θα τον καλέσουμε στην αρχή!

Gosub Myclass ' define Mem() class functionClass mTree2 {
      item
      pLeft=-1
      pRight=-1
}
Clear TreeOne
M=Mem(100)
MakeTree(&TreeOne,5)
Insert(&TreeOne,8)
Insert(&TreeOne,4)
Insert(&TreeOne,3)
\\Print TreeOneDisp(TreeOne)
Print "Disp DFS"
DispDFS(TreeOne)
Clear TreeTwo
MakeTree(&TreeTwo, 100)
Insert(&TreeTwo,108)
Insert(&TreeTwo,99)
Insert(&TreeTwo,150)
Insert(&TreeTwo,98)
Insert(&TreeTwo,145)
\\ Print TreeTwoPrint "Disp DFS"
DispDFS(TreeTwo)
End
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 string pointers            If .IsNull(A) Then Error "Invalid Pointer"
            =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