Γρήγορη Ταξινόμηση σε πίνακα με ρουτίνα

Εδώ έχω μια μικρή εφαρμογή που δείχνει την Γρήγορη ταξινόμηση ως ρουτίνα (και βοηθητικές) στην Μ2000 (οι ρουτίνες έχουν αναδρομή). Είναι σαν εφαρμογή, εμφανίζει τίτλο, αποτελέσματα, περιμένει ένα πλήκτρο και πάει στο επόμενο αποτέλεσμα.
Είναι γραμμένο με δυνατότητες από την 8.2 έκδοση, αν 15, οπότε καλό είναι όποιος έχει κατεβάσει παλαιότερη έκδοση να την αναβαθμίσει. Φαίνεται και η χρήση της λάμδα ως μετρητής, και η χρήση του χειριστή << για αλλαγή κάθε στοιχείου στο πίνακα στην εντολή Πίνακας.

Υπάρχει και αλλο πρόγραμμα με χρήση της γρήγορη ταξινόμηση αλλά σε στοιχεία του σωρού, με μετακινήσεις από και προς την κορυφή, και εκεί το πρόγραμμα βγάζει σειρές υποσυνόλων σε σύνολα, και ταξινομεί κάθε υποσύνολο: Δες εδώ

Υπάρχουν εντολές ταξινόμησης σε αντικείμενα τύπου Έγγραφο (Document) )και τύπου Κατάσταση (Inventory), αλλά εδώ βλέπουμε την μορφή της με εντολές της Μ2000.
Επειδή οι πίνακες μπορούν να έχουν πίνακες ή άλλα αντικείμενα, η εντολή Άλλαξε (Swap), λειτουργεί στο βάθος, και μεταφέρει 12byte, που μπορεί να έχουν την τιμή και το είδος, ή να έχουν δείκτη σε αντικείμενο. Γενικά η Μ2000 δεν αφήνει να διαβάσουμε δείκτη σε αντικείμενο, ούτε να βάλουμε δική μας τιμή στο δείκτη. Γνωρίζει τι είναι αντικείμενο, επειδή δημιουργεί αντικείμενα και ασχολείται με τους έτοιμους δείκτες όταν φτιάχνουμε νέα αντικείμενα. Εκτός από ειδική περίπτωση (δες Κατάσταση) όλα τα άλλα αντικείμενα έχουν αναλογία ένας δείκτης- ένα αντικείμενο. Οι αναφορές σε αυτά τα αντικείμενα είναι έμμεσος δείκτης στο πραγματικό δείκτη. Στις καταστάσεις μπορούμε να κάνουμε κυκλική αναφορά, δηλαδή να έχει η κατάσταση αναφορά στον εαυτό της, ή χειρότερα, αναφορά σε άλλη όπου η άλλη να έχει αναφορά στην πρώτη. Η Μ2000 έχει τρόπο να βρίσκει αυτές τις κυκλικές αναφορές και να τις καταστρέφει όταν πρέπει!

\\ γρήγορη ταξινόμηση
\\  φτιάχνουμε την οθόνη να δείχνει 40 γραμμές με 60 χαρακτήρες
Φόρμα 60,40
Οθόνη 5 : Πένα 14
\\ με το 2 βάζουμε στο κέντρο της γραμμής την αναφορά μας!

Διπλά  \\ διπλού ύψους και πλάτους γράμματα
Αναφορά 2,"Γρήγορη Ταξινόμηση με χρήση Ρουτινών με Αναδρομή"
Κανονικά
Οθόνη 1,2: Πένα 11 \\ το 2 σημαίνει ότι χωρίζει η οθόνη από την τρίτη γραμμή

\\ Δυο γεννήτριες αριθμών - φτιαγμένες σε συναρτήσεις τύπου λάμδα
\\ αυτές μπορούν να έχουν δικές τους μεταβλητές που δεν σβήνουν μετά την κλήση
\\ αυτό μας βολεύει για να φτιάχνουμε μετρητές.

Counter =Λάμδα x=1 ->{ =x : x++}
CounterRev =Λάμδα x=30 ->{ =x : x--}

\\
\\ φτιάχνουμε δυο πίνακες, και γεμίζουμε τον ένα

Βάση 0 \\ εξ ορισμού είναι 0 αλλά δεν μας πειράζει να το ορίσουμε ξανά

\\ οι πίνακες κρατούν την βάση 0 ή 1 μέχρι να χαθούν.
\\ ο χειριστής << δηλώνει εδώ "εκτέλεσε την συνάρτηση δεξιά για κάθε στοιχείο"

Πίνακας arr(30)<<CounterRev(), old()

\\ αν θέλουμε σκιάζουμε την παρακάτω με \\
\\ η παρακάτω εντολή σημαίνει βάλε από το 0 και πάνω τα στοιχεία μετά το =
\\ άλλαξε το (0) με (10) για να πάβε από το 10 και μετά...
arr(0)=4,2,3,102,23,21,1,54,26,9

\\ αντιγραφή του πίνακα για να μπορούμε να δείξουμε τον παλιό με τον κανούριο
old()=arr()

\\ ξεκινάμε από τη βάση
γρήγορη_ταξινόμηση(&arr(), 0, 29)
Διαμέσου τύπωσε_πίνακα
περίμενε_πλήκτρο()

\\ όλα τα στοιχεία ίδια
Πίνακας arr(30)=1, old() : old()=arr() : γρήγορη_ταξινόμηση(&arr(), 0, 29)
Διαμέσου τύπωσε_πίνακα
περίμενε_πλήκτρο()

\\ ταξινομημένος
Πίνακας arr(30)<<counter(), old() : old()=arr() : γρήγορη_ταξινόμηση(&arr(), 0, 29)
Διαμέσου τύπωσε_πίνακα
περίμενε_πλήκτρο()
\\ κρατάμε αντίγραφο της λάμδα σε μια μεταβλητή ως νέα λάμδα συνάρτηση
counterrev2=counterrev

\\ δοκιμάζουμε σε νέους πίνακες με βάση 1 (από 1 έως 30 αντί από 0 έως 29)
\\ η γρήγορη ταξινόμηση δεν αλλάζει, γιατί δίνουμε πάντα από την αρχή το διάστημα που θα λειτουργήσει

Βάση 1 : Πίνακας arr1(30)<<counterrev(), old1() : old1()=arr1() : Βάση 0 \\ να μη τον ξεχνάμε!
γρήγορη_ταξινόμηση(&arr1(), 1, 30)
Διαμέσου τύπωσε_πίνακα1
περίμενε_πλήκτρο()

Βάση 1 : Πίνακας arr1(30)<<counterrev2()*4, old1()
για i=2 έως 30 ανα 2 : arr1(i)-! : arr1(i)+=4 : επομενο i
old1()=arr1() : Βάση 0 \\ να μη τον ξεχνάμε!
γρήγορη_ταξινόμηση(&arr1(), 1, 30)
Διαμέσου τύπωσε_πίνακα1
περίμενε_πλήκτρο()

Τέλος
τύπωσε_πίνακα:
      \\ Απλή ρουτίνα, δεν έχουμε κάτι να περάσουμε
      \\ ούτε να δημιουργήσουμε τοπικά όπως κάνουμε στις ρουτίνες.
      \\ η Διαμέσου είναι η Gosub. Και οι ρουτίνες μπορούν να κληθούν με Διαμέσου
      \\ και πρέπει αν το όνομα της ρουτίνας είναι ίδιο όνομα πίνακα στο τμήμα.   
      Για i=0 Έως 29
            Τύπωσε μορφη$("{0:-8}={1::4}  {2::-4}",μορφη$("arr({0})", i),arr(i), old(i))
      Επόμενο i
Επιστροφή
τύπωσε_πίνακα1:
      Για i=1 Έως 30
            Τύπωσε μορφη$("{0:-9}={1::4}  {2::-4}",μορφη$("arr1({0})",i), arr1(i), old1(i))
      Επόμενο i
Επιστροφή
Ρουτίνα περίμενε_πλήκτρο()
      Διπλά
      Αναφορά 2, "Πάτησε ένα πλήκτρο"
      Κανονικά
      Τοπική a$=Κομ$
Τέλος Ρουτίνας
\\ τα ονόματα των ρουτινών αν είναι ελληνικά τότε πρέπει να έχουν και την εντολή ρουτίνα με ελληνικά
\\ αν είναι στα αγγλικά πρέπει να έχουν την εντολή Sub και στο τέλος End Sub.
\\ με & σημαίνει με αναφορά. Εδώ το Α() δείχνει ότι το arr()
Ρουτίνα γρήγορη_ταξινόμηση(&A())
      \\ Αυτή χρειάστηκε μόνο για να δημιουργήσει την Α()
      \\ που είναι αναφορά της arr()
      \\ μέχρι το τέλος αυτής της ρουτίνας, θα υπάρχει και αυτή η αναφορά
      \\ τα δυο νούμερα που έχουμε περάσει τα αφήνουμε να τα διαβάσει
      \\ η γρήγορη()
      Αναλυτής
      γρήγορη()
      Οθόνη : Τύπωσε Φόρτος \\ μετράμε τον φόρτο ως  χρόνος εκτέλεσης
Τέλος Ρουτίνας
Ρουτίνα ταξινόμησε(p,r)
      Τοπική x = A(r), i = p-1
      Για j=p Έως r-1
            Αν A(j) <= x Τότε i = i+1 : Άλλαξε A(i),A(j)
      Επόμενο j
      Άλλαξε A(i+1),A(r)
      Βάλε i+1
      \\ οι ρουτίνες είναι μέρη τμήματος, και χειρίζονται τον ίδιο σωρό τιμών\
      \\ έτσι μπορούν να διαβάζουν από αυτόν αλλά και να βάζουν τιμές σε αυτόν
Τέλος Ρουτίνας
Ρουτίνα γρήγορη(p, r)
      Αν p >= r Τότε Έξοδος Ρουτίνας
      ταξινόμησε(p, r) : Διάβασε τοπικά q
      γρήγορη(p, q - 1)
      γρήγορη(q + 1, r)
Τέλος Ρουτίνας


Τέλος εδώ είναι η QuickSort στα αγγλικά και χωρίς τη χρήση ρουτινών. Η κλήση της quicksort γίνεται με την Call Local (Κλήση τοπικά) για να συμβαίνει ότι και με τις υπορουτίνες, να εκτελούνται ως μέρη του τμήματος, άρα να βλέπουν την partition. Διαφορετικά θα έπρεπε να κάνουμε Global την partition (Function Global partition { ... }) και να αφαιρέσουμε το Local στο Call (κλήση). Πιο κάτω είναι η άλλη λύση με τη χρήση αναδρομής σε συνάρτηση ομάδας (Group)

Base 0
\\ Quick Sort using Call Local
Function partition {
         Read &A(), p, r
         x = A(r)
         i = p-1
         For j=p to r-1 {
             If A(j) <= x Then {
                       i = i+1
                    Swap A(i),A(j)
                 }
          }
          Swap A(i+1),A(r)
         = i+1
      }
Function quicksort {
     Read New &A(), p, r
     If p < r Then {
       q = partition(&A(), p, r)
       Call Local quicksort(&A(), p, q - 1)
       Call Local quicksort(&A(), q + 1, r)
    }
}

Dim arr(10), old()
arr(0)=23,21,1,4,2,3,102,54,26,9
old()=arr()
Call Local quicksort(&arr(), 0, 9)
For i=0 to 9
      Print arr(i), old(i)
Next i

Εδώ έχουμε ομάδα (Group) με συναρτήσεις. Οι συναρτήσεις σε μια ομάδα βλέπουν τις άλλες συναρτήσεις της ομάδας (και τυχόν δικές τους), εφόσον ορίζονται στο ίδιο επίπεδο, αλλά και συναρτήσεις άλλων υποομάδων στην ομάδα. Την συνάρτηση partition την έχουμε ιδιωτική (private), δηλαδή δεν μπορεί να κληθεί απ΄έξω!

Base 0
\\ Using a Group
Group Quick {
Private:
      Function partition {
               Read &A(), p, r
               x = A(r)
               i = p-1
               For j=p to r-1 {
                   If A(j) <= x Then {
                             i = i+1
                          Swap A(i),A(j)
                       }
                }
                Swap A(i+1),A(r)
               = i+1
            }
Public:
      Function quicksort {
           Read &A(), p, r
           If p < r Then {
             q = .partition(&A(), p, r)
             Call .quicksort(&A(), p, q - 1)
             Call .quicksort(&A(), q + 1, r)
          }
      }
}
Dim arr(10), old()
arr(0)=23,21,1,4,2,3,102,54,26,9
old()=arr()
Call Quick.quicksort(&arr(), 0, 9)
For i=0 to 9
      Print arr(i), old(i)
Next i

Tutorial for Groups in M2000

To run this code, please copy it in module in M2000 environment, (M2000.exe): Start the environment, type Edit A, copy this program from browser, press Esc to return to CLI (command line interpreter), and type A and press Enter.

Group Abc { X=10, Y, Z$="Yes"}
For This {
      \\ This is a block for temporary definitions
      Group Temp {X=12, W=13}
      \\ we make a copy as "float" group
      \\ float groups are groups in stack and arrays and the result of any function which return group
      \\ non float group, static, is a group with a name, and position in module.
      \\ Group Temp erased after the exit of this block
      Push Temp
}
\\ now reading a group from stack to named (static) group means Join
Read Abc

\\ We see that we get new value for Abc.X, and a new variable Abc.W
For Abc {
      Print .X, .Y, .W, .Z$ \\
}
List   \\ we see all 5 variables group and four group variables

\\ Why is 5? Because in a named group each element exist as it is not in a group.
\\ We can't delete a already defined variable (until module exit) and this happen for groups.
\\ So groups can take more variables and other (Arrays, Functions etc), temporary or not.
\\ We can pass a variable from group by reference without passing the group.
Module CheckRef {
      Read &M
      M++
      Print M \\14
}
\\ by referenece one variable from group Abc
CheckRef &Abc.W
Print Abc.W \\14

\\ We can Add function to group
Group Abc {
      Function CheckIt {
            \ one dot mean This.
            This.X++ \\ change some state
            .Y+=3
            =.X*.W+.Y
      }
}
Print Abc.CheckIt() \\ 185
Print Abc.CheckIt() \\ 202
Print Abc.CheckIt() \\ 219

\\ We can pass a function of Group in a module, and we can change state inside it,
Module PassFunc {
      Read &F()
      Print F() \\ 236
}
PassFunc &Abc.CheckIt()

Module PassAll {
      Read &AbcRef
      \\ now AbcRef is a group
      For AbcRef {
            Print .X, .Y, .W, .Z$
      }
      List  \\ there are 5 more variables
}
PassAll &Abc
\\ Some times is better to pass a weak reference only
\\ this can be done using Weak$() or & operator
\\ but important is what we have in Read

Module WeakPass {
      Read A$
      For A$ {
            Print .X, .Y, .W, .Z$
      }
      \\ we can use A$ to call modules or change variables
      A$.X+=10
      Print Eval(A$.X) \\ we must read using Eval(), or Eval$() for strings
      Print Eval(A$.CheckIt()) \\ 393      
      List  \\ there are NO 5 more variables, only a new string variable (weak reference)
}
WeakPass &Abc
For This {
      \\ temporary use
      Local M, I=Group.Count(Abc)
      For M=1 to I : Print member$(Abc, M), member.type$(Abc, M) : Next M
      \\ we use New so we shadow any variable with same name
      Read New From Abc, X, Y$, Z$, W
      \\ these are references. If not match type (array or variable) we get error
      \\ Here we make string the reference to Y
      Print X, Y$, Z$, W
      Z$="it is a reference to Abc.Z$"
      Y$="1500"
}
List
Print Abc.Z$, Abc.Y \\  "it is a reference to Abc.Z$"   1500

\\ until here____________________________________________

A small program:

\\ We can make reference from number to string variable
A=10
Link A to A$
\\ feed A$ from A
For A=A to A+10 {
      Print A$;
}
Print
\\ feed A from A$
A$="1212.1292"
Print A*100

Advanced Program
M2000 has no interfaces for Groups (Groups are like javascript objects, but not exactly). So here is a program to implement "interface". The task not only needed for give interface to group for particular task, but we need to take feedback, so we must find a way to add functions to groups and from what we get, we need to take something back.
Our feedback is kept in counter in each item (circle or rect). The interface is kept in another group named Geometry. We use a function type$() to define "soft" type. So function interface choose the right group to export. This group then joined to original group

Clear  \\ variables
Flush  \\ Stack for values

Class Circle { Radius, counter
      Function Type$ {="Circle"}
}
Class Rect { Height, Width, counter
      Function Type$ {="Rect" }
}
Group Geometry {
Private:
      Group Geometry_Rect {
            Function Perim { =.Height*2+.width*2}
            Function Area { =.Height*.width}
      }
      Group Geometry_Circle {
            Function Perim { =.Radius*2*pi}
            Function Area { =.Radius**2*pi}
      }
Public:
      Function Interface {
            Read What
            If What.Type$()="Circle" then {
                  =.Geometry_Circle
            } else {
                  =.Geometry_Rect
            }
      }
}
\\ main
Base 1
Dim A(10)=Circle(), B(10)=Rect(), Mix(10)
A(1).Radius=5 \\ we can put .Radious=5 inside For A(1) { }
For A(1) {
      measure(&this, &Geometry.Interface())
}
For B(1) {
      .Width=3 : .Height=4
      measure(&this , &Geometry.Interface())
}
Print A(1).counter, B(1).counter
Mix(1)=A(1)
Mix(2)=B(1)
For Mix(1) {
      measure(&this, &Geometry.Interface())
}
For Mix(2) {
      measure(&this , &Geometry.Interface())
}
Sub measure(&G, &Geometry()) \\ group refer and function (from group) refer
    G=Geometry(G) \\ temporary union with group Geometry
    Print format$("Type     {0:12}", G.Type$())
    Print format$("Area     {0:3:-10}mm",G.Area())
    Print format$("Perimeter{0:3:-10}mm",G.Perim())
    G.counter++ \\ this is feedback
End Sub
___________________________________
And here is another variant of  previous program. Now we don't use a Group Function to return group, but a function. From Sub measure we see everything from module, so we see Function Geometry. More simple now:

Clear  \\ variables - help on developing this
Flush  \\ Empty Stack for values

Class Circle { Radius, counter
      Function Type$ {="Circle"}
}
Class Rect { Height, Width, counter
      Function Type$ {="Rect" }
}
Function Geometry {
            Read What
            If What.Type$()="Circle" then {
                  Group Geometry_Circle {
                        Function Perim { =.Radius*2*pi}
                        Function Area { =.Radius**2*pi}
                  }
                  =.Geometry_Circle
            } else {
                  Group Geometry_Rect {
                        Function Perim { =.Height*2+.width*2}
                        Function Area { =.Height*.width}
                  }
                  =.Geometry_Rect
            }
}
\\ main
Base 1
Dim A(10)=Circle(), B(10)=Rect(), Mix(10)
A(1).Radius=5 \\ we can put .Radious=5 inside For A(1) { }
For A(1) {
      measure(&this)
}
For B(1) {
      .Width=3 : .Height=4
      measure(&this)
}
Print A(1).counter, B(1).counter
Mix(1)=A(1)
Mix(2)=B(1)
For Mix(1) {
      measure(&this)
}
For Mix(2) {
      measure(&this)
}
Sub measure(&G) \\ group refer and function (from group) refer
    \\ sub see anything in module, so can see Geometry()
    G=Geometry(G) \\ temporary union with group Geometry
    Print format$("Type     {0:12}", G.Type$())
    Print format$("Area     {0:3:-10}mm",G.Area())
    Print format$("Perimeter{0:3:-10}mm",G.Perim())
    G.counter++ \\ this is feedback
End Sub


Previous program, with a change. We can pass function G.type$() by reference of each group to Geometry() and not all group, to choose the functions we want to bind to G.
When a function of Group passed by reference we have a new function (a copy of Group's function, with a proper weak reference to Group, so any identifier inside function with a dot precede it, connect by weak reference to actual members of group. All functions and modules in a group have a weak reference to group. When a Group has no name (as those in an array), no weak reference exist. When we open a Group from array item, then interpreter make a new group with a hidden name and make all members using this name, and pass references to this group to modules and functions, and the identifier This refer to this hidden name.
So passing function only, we don't make a copy of group, just a copy of one function.

How reference for Group works

Here we pass a reference of This to sub Measure(), so  interpreter make all members, as identifiers and pointers to actual members of This (we say This but this is an alias, of a copy in of Mix(i)). But G Group has not a pointer to This, has a list of members, as G.identifier_of_member. Calling Geometry() we pass G.type$() which points to This.type$() so we get the weak reference of This. So any bind to G from Geometry, listed only to G and not toThis. So we have two lists, as two objects, with two set of members, but for G some members points to This members, and some aren't references but are new members to G.

From 8.2 we can make the Read Parameter1,...  as  Function Name (Parameter1,...) {function code  }. Interpreter get the parameter list and insert a Read command as first line.
Another change is the For.. to... {} for Mix() array.
Command Modules ? display modules as they are in Modules/Functions List (if not hidden, or private)

Clear  \\ variables - help on developing this
Flush  \\ Empty Stack for values

Class Circle { Radius, counter
      Function Type$ {="Circle"}
}
Class Rect { Height, Width, counter
      Function Type$ {="Rect" }
}
Function Geometry (&What$()) {
            If What$()="Circle" then {
                  Group Geometry_Circle {
                        Function Perim { =.Radius*2*pi}
                        Function Area { =.Radius**2*pi}
                  }
                  =.Geometry_Circle
            } else {
                  Group Geometry_Rect {
                        Function Perim { =.Height*2+.width*2}
                        Function Area { =.Height*.width}
                  }
                  =.Geometry_Rect
            }
}
\\ main
Base 1
Dim A(10)=Circle(), B(10)=Rect(), Mix(10)
A(1).Radius=5 \\ we can put .Radious=5 inside For A(1) { }
For A(1) {
      measure(&this)
}
For B(1) {
      .Width=3 : .Height=4
      measure(&this)
}
Print A(1).counter, B(1).counter
Mix(1)=A(1)
Mix(2)=B(1)
For i=1 to 2 {
      For Mix(i) {
            measure(&this)
      }
}
MM=Mix(1)
Modules ?
Sub measure(&G) \\ group refer and function (from group) refer
    \\ sub see anything in module, so can see Geometry()
    G=Geometry(&G.type$()) \\ temporary union with group Geometry
    Print format$("Type     {0:12}", G.Type$())
    Print format$("Area     {0:3:-10}mm",G.Area())
    Print format$("Perimeter{0:3:-10}mm",G.Perim())
    G.counter++ \\ this is feedback
    Modules ?
End Sub

Very Advanced

Here we have an Event inside Group.

Group aa {
Private:
      y=123
Public:
      \\ event need a Read parameter list
      \\ so any function added to Event must have same signature
      Event b { Read x, &counter }
      Function aa (x, &counter) {
            Print x+.y
             .y++
            Print ".y=";.y
            counter++
      }
      Module callme {
            Call Event .b, number
      }
}
Class cbb {
Private:
      y=456
Public:
      function bb (x, &cnt) {
            print x**2+.y
            cnt++
      }
Class:
      Module cbb (.y) { }
}
bb=cbb(456)

Event aa.b New aa.aa(), bb.bb()
mycounter=0
aa.callme 10, &mycounter
aa.callme 10, &mycounter
Print mycounter
Module testme (c) {
      Print Module$ \\ name of module
      Stack  \\ display stack (for values not process stack), now have 5 as top value
      \\ a module get parent stack so 5 passed with stack to c.callme module
      c.callme
}
\\ aa by copy
mycounter=0
testme aa, 5, &mycounter
Module testme2 (&c) {
      Print Module$
      c.callme
}
Print  "Calls number=";mycounter
\\  aa by reference
mycounter=0
Event aa.b Drop aa.aa()
testme2 &aa, 10, &mycounter
Print mycounter
Event aa.b Hold
testme2 &aa, 10, &mycounter
Function SomethingElse (x, &cnt) {
      Print ">>>>>>>>>>>",x, cnt
}
Print mycounter
Event aa.b Clear \\ after Clear we need to Release Event
Event aa.b New aa.aa(), aa.aa(), bb.bb(), bb.bb(), SomethingElse()
Event aa.b Drop aa.aa()
Event aa.b Release
mycounter=0
testme2 &aa, 10, &mycounter
Print mycounter