Παράδειγμα με ουρά προτεραιότητας στην Μ2000

Εδώ θα δούμε μια Priority List, ως ένα αντικείμενο που δέχεται αντικείμενα τα οποία τα βάζει στην ουρά. Δεν τα ταξινομεί, αλλά κρατάει το μέγιστο ξεχωριστά. Δεν γνωρίζει πώς να συγκρίνει και για το λόγο αυτό δίνουμε μια λάμδα συνάρτηση για να το κάνει πάνω στα αντικείμενα που έχουμε φτιάξει. Τα αντικείμενα φέρουν μόνο μια ιδιότητα την Χ.

Εσωτερικά έχει έναν πίνακα, ο οποίος είναι ιδιωτικός, όπως και μια σειρά ιδιοτήτων. Τα μόνα δημόσια είναι ο κατασκευαστής (έχει το ίδιο όνομα με τη κλάση, και είναι τμήμα), η Add, η Peek(), η Poll(), η Remove και η Size() και η Clear

Στο παράδειγμα ο Διερμηνευτής ετοιμάζει μια συνάρτηση PriorityQueue() που παράγει το αντικείμενο. Όμως του παρέχει ως τμήμα το PriorityQueue, το οποίο μπορεί να δώσει μέγεθος και συνάρτηση λάμδα για σύγκριση.


Class PriorityQueue {
Private:
      Dim Item()
      many=0, level=0, first
      cmp = lambda->0
      Module Reduce {
            if .many<.first*2 then exit
            If .level<.many/2 then .many/=2 : Dim .Item(.many)
      }
Public:
      Module Clear {
        Dim .Item() \\ erase all
        .many<=0 \\ default
        .Level<=0
      }
      Module PriorityQueue {
            If .many>0 then Error "Clear List First"
            Read .many, .cmp
            .first<=.many
            Dim .Item(.many)
      }
      Module Add {
           If .level=.many Then {
                 If .many=0 then Error "Define Size First"
                  Dim .Item(.many*2)
                  .many*=2
           }
           Read Item
           If .level=0 Then {
                 .Item(0)=Item
           } Else.if .cmp(.Item(0), Item)=-1 Then { \\ Item is max
                 .Item(.level)=Item
                 swap .Item(0), .Item(.level)
           } Else .Item(.level)=Item
           .level++
      }
      Function Peek {
            If .level=0 Then error "empty"
            =.Item(0)
      }
      Function Poll {
            If .level=0 Then error "empty"
            =.Item(0)
            If .level=2 Then {
            swap .Item(0), .Item(1)
            .Item(1)=0
            .Level<=1
            } Else.If .level>2 Then {
                  .Level--
                  Swap .Item(.level), .Item(0)
                  .Item(.level)=0
                  For I=.level-1 to 1 {
                        If .cmp(.Item(I), .Item(I-1))=1 Then Swap .Item(I), .Item(I-1)
                  }
            } else .level<=0 : .Item(0)=0
            .Reduce
      }
      Module Remove {
            If .level=0 Then error "empty"
            Read Item
            k=true
            If .cmp(.Item(0), Item)=0 Then {
                  Item=.Poll()
                  K~  \\ k=false
            } Else.If .Level>1 Then {
                  I2=.Level-1
                      For I=1 to I2 {
                              If k Then {
                                     If .cmp(.Item(I), Item)=0 Then {
                                           If I<I2 Then Swap .Item(I), .Item(I2)
                                           .Item(I2)=0
                                           k=false
                                     }
                              } else exit
                        }
                 .Level--
            }
            If k Then Error "Not Found"
            .Reduce
      }
      Function Size {
            If .many=0 then Error "Define Size First"
            =.Level
      }
}

Class Item { X
      Module Item { Read .X}
}
Function PrintTop {
      \\ use with Call Local - We make a wide scope to PrintTop
      \\ but M is local (auto)
      M=Queue.Peek() : Print "Item ";M.X
}
Comp=Lambda -> { Read A,B : =COMPARE(A.X,B.X)}

Queue=PriorityQueue(100,Comp)
\\ Goto there   \\ use for test
Queue.Add Item(10)
Call Local PrintTop()

Queue.Clear
\\ run construction again - is a module
\\ check to see how the size expanded and reduced
Queue.PriorityQueue 2, Comp

Queue.Add Item(5)
Call Local PrintTop()

Queue.Add Item(20)
Call Local PrintTop()
\\ there:
Queue.Add Item(8)
Call Local PrintTop()

Queue.Add Item(9)
Call Local PrintTop()

Print "Remove Item 8"
Try {
      Queue.Remove Item(8)
      Print "ok"
}

Queue.Add Item(19)
Call Local PrintTop()

While true {
      MM=Queue.Poll()
      Print MM.X
      Print "Size="; Queue.Size()
      If Queue.Size()=0 Then exit
      Try ok {
            Call Local PrintTop()
      }
\\      If Error Then Print Error$ : Exit  
}



Εδώ το τελευταίο τμήμα με ρουτίνα. Οι ρουτίνες γράφονται στο τέλος. Πριν οι τελευταίες εκδόσεις της γλώσσας χρησιμοποιούν μετά τη πρώτη αναζήτηση πίνακα κατακερματισμού για να γρήγορη αναζήτηση. Από τότε που μπήκαν αυτοί οι πίνακες για τις ρουτίνες έγιναν πιο γρήγορες από τις συναρτήσεις (και αυτές έχουν παρόμοιο πίνακα, αλλά τα ονόματα των συναρτήσεων, όπως και των τμημάτων έχουν και ένα μέρος, ένα πρόθεμα που δεν φαίνεται, άρα η συνάρτηση κατακερματισμού δουλεύει για περισσότερους χαρακτήρες, άρα κερδίζει η ρουτίνα, επειδή ο πίνακας ανήκει τοπικά στο αντικείμενο εκτέλεσης - την επόμενη φορά που θα κληθεί το τμήμα θα ξαναστηθεί ο πίνακας, αλλά γίνεται γρήγορα, και πάντα στην πρώτη αναζήτηση).
Γράφω από την Comp απευθείας, ως όρισμα στην PriorityQueue. Η εντολή Read A,B (Διαβάζει από το σωρό τιμών) θα μπεί από τον διερμηνευτή.

Queue=PriorityQueue(100, Lambda (A, B) -> { =COMPARE(A.X,B.X)})
\\ Goto there   \\ use for test Queue.Add Item(10) PrintTop()

Queue.Clear
\\ run construction again - is a module
\\ check to see how the size expanded and reduced Queue.PriorityQueue 2, Lambda (A, B) -> { =COMPARE(A.X,B.X)}

Queue.Add Item(5) PrintTop()

Queue.Add Item(20) PrintTop()
\\ there: Queue.Add Item(8) PrintTop()

Queue.Add Item(9) PrintTop()

Print "Remove Item 8" Try {
      Queue.Remove Item(8)
      Print "ok" }

Queue.Add Item(19) PrintTop()

While true {
      MM=Queue.Poll()
      Print MM.X
      Print "Size="; Queue.Size()
      If Queue.Size()=0 Then exit
      Try ok {
            PrintTop()
      }
\\      If Error Then Print Error$ : Exit    }

Sub PrintTop()
      Local M=Queue.Peek()
      Print "Item ";M.X
End Sub