Παρασκευή, 9 Νοεμβρίου 2018

Νέα έκδοση 9.5

Στην έκδοση 9.5 προστέθηκαν τα παρακάτω:

1. Μπορούμε πια να χρησιμοποιούμε πέρασμα με αναφορά στοιχεία πίνακα, και στατικές μεταβλητές. Χρησιμοποιείται ο μηχανισμός copy in copy out, όπου ο διερμηνευτής φτιάχνει πριν την κλήση μεταβλητές και περνάει αυτές με αναφορά (που κανονικά γίνεται) και στην επιστροφή ενημερώνει πίσω. Στις προηγούμενες εκδόσεις μπορούσαμε να περνάμε μόνο ολόκληρο το πίνακα με αναφορά (καθώς και με αντιγραφή, πέρασμα με τιμή), όπως επίσης οποιεσδήποτε μεταβλητές και συναρτήσεις.

static k=5
module In {
      read &x, &b$, &k
      x++
      k++
      print x, x*k
      b$+="ok"
}
Dim a(10)=5, z$(30)="hello"
In &a(5), &z$(2), &k
Print a(5), z$(2), k
List






2. Οι αυτόματοι πίνακες ή tuple, καθώς και οι κανονικοί πίνακες (μόνο για αυτούς που έχουν όνομα σαν αριθμητική μεταβλητή),έχουν πια δικές τους συναρτήσεις που μπορούν να χρησιμοποιηθούν αθροιστικά. Θα αναφερθώ σε αυτά σε άλλη ανάρτηση, με παραδείγματα με ελληνικές εντολές

a=(1,2,3,4,5)
Print a#rev()
Print a#sum()=15
Print a#max()=5, a#min()=1
k=-1
L=-1
Print a#max(K)=5, a#min(L)=1
Print K=4 ' 5th position
Print L=0 ' 1st position
Print a#pos(3)=2 ' 3rd position
Print a#val(4)=5
\\ tuples in tuple
a=((1,2),(3,4))
Print a#val(0)#val(1)=2
Print a#val(1)#val(1)=4
a=(1,2,3,4,5,6,7,8,9)
fold1=lambda ->{
      push number+number
}
Print a#fold(fold1)=a#sum()
Print a#fold(fold1,1)=a#sum()+1
even=lambda (x)->x mod 2=0
b=a#filter(even, (,))
Print b ' 2 4 6 8
Print a#filter(even)#fold(fold1)=20
map1=lambda (a)->{
      push a+100
}
c=b#map(map1)
Print c ' 102,103, 104, 105
numbers=lambda p=1 (x) ->{
      push x+p
      p++
}
oldnumbers=numbers ' we get a copy of numbers with p=1
c=c#map(numbers)
Print c ' 103, 106, 109, 112
zfilter=lambda -> number>106
tostring=lambda -> {
      push chrcode$(number)
}
oneline=lambda -> {
             shift 2 ' get second as first
             push letter$+letter$
}
Line$=c#filter(zfilter)#map(tostring)#fold$(oneline,"")
print Line$="mp", chrcode$(109)+chrcode$(112)
zfilter=lambda -> number>200
Line$=""
Line$=c#filter(zfilter)#map(tostring)#fold$(oneline,"")
\\ lines$ can't change value becuse filter has no items to give
Print Line$=""
\\ if we leave a second parameter without value the we get No Value error
Try {
      Line$=c#filter(zfilter, )#map(tostring)#fold$(oneline,"")
}
Print error$=" No value"
\\ second parameter is the alternative source
Line$=c#filter(zfilter,(109,112))#map(tostring)#fold$(oneline,"")
Print Line$="mp"
c=(1,1,0,1,1,1,1,0,1,1,0)
\\ hard insert
Print c#pos(1,0,1) ' 1  means 2nd position
Print c#pos(3->1,0,1) ' 6  means 7th position
\\ using another tuple
Print c#pos((1,0,1)) ' 1  means 2nd position
Print c#pos(3->(1,0,1)) ' 6  means 7th position
t=(1,0,1)
Print c#pos(t) ' 1  means 2nd position
Print c#pos(3->t) ' 6  means 7th position



3. Προστέθηκε μια συνάρτηση αλφαριθμητικών η Αναπ$() ή StrRev$() η οποία γυρίζει ένα αλφαριθμητικό ανάποδα (το πρώτο γράμμα γίνεται τελευταίο).
Print StrRev$("abcd")="dcba"


η συνάρτηση αυτή χρησιμοποιεί την StrReverse της VB6, η οποία είναι μεν γρήγορη αλλά δεν είναι σωστή, όταν έχουμε συνδυασμούς γραμμάτων

Το παράδειγμα παρακάτω δείχνει πως γίνεται σε περίπτωση συνδιασμού γραμμάτων με χρήση κώδικα της Μ2000. Η len.disp() γυρίζει το μήκος εμφάνισης (όχι το μήκος του αλφαριθμητικού). Αυτό μπορεί να το κάνει γιατί για κάθε χαρακτήρα βρίσκει το μήκος του, και οι χαρακτήρες που συνδυάζονται με άλλους (πέφτουν πάνω τους δηλαδή), έχουν μηδενικό μήκος!Στην πραγματικότητα έχουν μήκος, αλλά όταν πριν ακολουθεί χαρακτήρεας...δεν έχουν και πάνε πίσω και γράφουν από πάνω! Στο παράδειγμα "s⃝df̅" και το s και το f έχουν από ένα συνδυασμένο χαρακτήρα. Θέλουμε η περιστροφή να κρατήσει στη σειρά τους συνδυασμένους χαρακτήρες (αλλιώς αυτοί θα συνδυαστούν με τους επόμενους χαρακτήρες (η οποίοι θα γίνουν στην περιστροφή ...προηγούμενοι).




Function DispRev$(a$) {
      i=1: j=Len(a$): if j=0 then ="": exit
      z$=String$(" ",j): j++
      do {
            k$=mid$(a$, i, 1)
            if i<len(a$) then {
            while len.disp(k$+mid$(a$, i+1,1)) =len.disp(k$) {
                  k$+=mid$(a$, i+1,1) : i++ : if i>len(a$) then exit
                  j-- } : j-- : insert j, len(k$) Z$=K$
            } else j-- :Insert j,1 z$=k$
            i++
           
      } until i>len(a$)
       =z$
}
Print DispRev$("abcd")="dcba"
Print DispRev$("")=""
Print DispRev$("s⃝df̅")="f̅ds⃝"



Δευτέρα, 5 Νοεμβρίου 2018

Evolutionary Algorithm

first publish in rosettacode.org




Module WeaselAlgorithm {
      Print "Evolutionary Algorithm"
      \\ Weasel Algorithm
      \\ Using dynamic array, which expand if no fitness change,
      \\ and reduce to minimum when fitness changed
      \\ Abandon strings when fitness change
      \\ Also lambda function Mutate$ change when topscore=10, to change only one character
      l$="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
      randomstring$=lambda$ l$ ->{
            res$=""
            For i=1 to 28: res$+=Mid$(L$,Random(1,27),1):next i
            =res$
      }
      m$="METHINKS IT IS LIKE A WEASEL"
      lm=len(m$)
      fitness=lambda m$, lm (this$)-> {
            score=0 : For i=1 to lm {score+=If(mid$(m$,i,1)=mid$(this$, i, 1)->1,0)} : =score
      }
      Mutate$=lambda$ l$ (w$)-> {
            a=random(1,28) : insert a, 1 w$=mid$(l$, random(1,27),1)
            If random(3)=1 Then b=a:while b=a {b=random(1,28)} : insert b, 1 w$=mid$(l$, random(1,27),1)
            =w$
      }
      Mutate1$=lambda$ l$ (w$)-> {
            insert random(1,28), 1 w$=mid$(l$, random(1,27),1) : =w$
      }
      f$=randomstring$()
      topscore=0
      last=0
      Pen 11 {Print "Fitness |Target:", @(16),m$, @(47),"|Total Strings"}
      Print Over $(3,8), str$(topscore/28,"##0.0%"),"",$(0),f$, 0
      count=0
      gen=30
      mut=0
      {
            last=0
            Dim a$(1 to gen)<<mutate$(f$)
            mut+=gen
            oldscore=topscore
            For i=1 to gen {
                  topscore=max.data(topscore, fitness(a$(i)))
                  If oldscore<topscore Then last=i:Exit
            }
            If last>0 Then {
                  f$=a$(last) : gen=30 : If topscore=10 Then mutate$=mutate1$
            } Else gen+=50
            Print Over $(3,8), str$(topscore/28,"##0.0%"), "",$(0),f$, mut : refresh
            count+=min(gen,i)
            If topscore<28 Then loop
      }
      Print
      Print "Results"
      Print "I found this:"; a$(i)
      Print "Total strings which evalute fitness:"; count
      Print "Done"
}
WeaselAlgorithm



Fitness |Target: METHINKS IT IS LIKE A WEASEL |Total strings
    3,6%         ZZBZSVEOWPSQGJXNIXTFQCDQTJFE        30
    7,1%         ZZBZSVEOWPSQGJXNIXTFQCDQAJFE        60
   14,3%         ZZBZSVEOWPTQGJXNIXTFACDQAJFE        90
   17,9%         ZZBZSVEOWPTQGJXNIXTFA DQAJFE       200
   21,4%         ZEBZSVEOWPTQGJXNIXTFA DQAJFE       230
   25,0%         ZEBZSVEOWPTQGJXNIXT A DQAJFE       260
   28,6%         MEBZSVEOCPTQGJXNIXT A DQAJFE       290
   32,1%         MEBZSVEOCITQGJXNIXT A DQAJFE       320
   35,7%         MEBZSVEOCITQGJXNIKT A DQAJFE       350
   39,3%         MEBZSVEOCITQGJ NIKT A DQAJFE       380
   42,9%         MEBZSVEOCITQGJ NIKT A WQAJFE       410
   46,4%         MEBZSVESCITQGJ NIKT A WQAJFE       440
   50,0%         MEBZSVESCITQIJ NIKT A WQAJFE       680
   53,6%         MEBZSVESCIT IJ NIKT A WQAJFE      1100
   57,1%         MEBZSVESCIT IJ LIKT A WQAJFE      1130
   60,7%         MEBZSVKSCIT IJ LIKT A WQAJFE      1240
   64,3%         MEBZSVKS IT IJ LIKT A WQAJFE      1480
   67,9%         MEBZSNKS IT IJ LIKT A WQAJFE      1900
   71,4%         MEBHSNKS IT IJ LIKT A WQAJFE      2010
   75,0%         METHSNKS IT IJ LIKT A WQAJFE      2430
   78,6%         METHSNKS IT IJ LIKE A WQAJFE      2670
   82,1%         METHSNKS IT IJ LIKE A WQAJFL      3090
   85,7%         METHSNKS IT IJ LIKE A WEAJFL      3330
   89,3%         METHSNKS IT IJ LIKE A WEASFL      3980
   92,9%         METHINKS IT IJ LIKE A WEASFL      4400
   96,4%         METHINKS IT IJ LIKE A WEASEL      5050
  100,0%         METHINKS IT IS LIKE A WEASEL      5290
Results
I found this:METHINKS IT IS LIKE A WEASEL
Total strings which evaluate fitness:3230




Κυριακή, 4 Νοεμβρίου 2018

Αναθεώρηση 27 Έκδοση 9.4

Διορθώθηκε η συνάρτηση Χρώμα() ή Color(). Προστέθηκε η εντολή Χρωμάτισε η οποία χρωματίζει ένα και μόνο εικονοστοιχείο (pixel), στα αγγλικά είναι η PSet.
Μπορούμε να χρησιμοποιήσουμε την PSET χωρίς παραμέτρους και χρωματίζει με την τρέχουσα πένα στο σημείο που δείχνει ο δρομέας γραφικών (δεν τον βλέπουμε αλλά οι συντεταγμένες, για κάθε επίπεδο, και αυτό της κονσόλας και στις φόρμες, κρατούνται σε κάθε αλλαγή του δρομέα που τυχόν κάνουν άλλες εντολές γραφικών),
Μπορούμε να δώσουμε ένα χρώμα (δεν θα αλλάξει το χρώμα της τρέχουσας πένας, αλλά θα χρησιμοποιηθεί αυτό που θα δώσουμε για την εντολή αυτή και μόνο). Επίσης μπορούμε να δώσουμε απόλυτες συντεταγμένες, χωρίς να αλλάξει ο δρομέας γραφικών, και να χρωματίσουμε ένα εικονοστοιχείο (απαραίτητα θα έχουμε δώσει και χρώμα).
Έτσι έχουμε τρεις περιπτώσεις:
PSET
PSET color
PSET color, x, y

Μπορούμε να μαθαίνουμε το χρώμα με την Σημείο ή Point, η οποία δουλεύει για συγκεκριμένο σημείο, εκεί που δείχνει ο δρομέας γραφικών. Ο δρομέας μπορεί να μετακινηθεί με την Θέση ή Move (πάντα σε Twips, οπότε αν θέλουμε να είναι σε Pixels, πρέπει τα pixels να τα πολλαπλασιάσουμε με το twipsX ή το twipsY ανάλογα. (σε νορμάλ οθόνες αυτά είναι το ίδιο νούμερο, το 15 όταν η οθόνη είναι 96dpi). Δηλαδή κάθε 15 twips έχουμε 1 pixel. Τα twips της οθόνης λέγονται λογικά, γιατί δεν είναι πραγματικά. Στη σελίδα του εκτυπωτή έχουμε τα πραγματικά twips, όπου 1440twips είναι μια ίντσα. (http://www.kylesconverter.com/length/twips-to-inches)

Αν στον εκτυπωτή έχουμε 15 twips για κάθε Pixel, τότε θα έχουμε 1440/15=96, δηλαδή 96dpi (τα pixels λέγονται dots στον εκτυπωτή). Αν έχουμε 1 twip για ένα dot τότε έχουμε 1440dpi. Αυτά έχουν σημασία όταν θέλουμε να ξέρουμε το μέγεθος μιας εικόνας αν τυπωθεί 1:1, ένα προς ένα, δηλαδή 1 pixel σε 1 dot. Επίσης αν θέλουμε να βάλουμε μια εικόνα με οποιοδήποτε πλάτος στο χαρτί σε πλάτος 5 εκατοστών θα πρέπει να υπολογίσουμε αν θα πρέπει να αυξήσουμε ή μειώσουμε το πλάτος, δηλαδή να βρούμε την κλίμακα ώστε να τυπωθεί σε 5 εκατοστά πλάτος, και φυσικά με την ίδια κλίμακα να εφαρμόσουμε και στο ύψος για να διατηρηθεί η αρχική αναλογία πλάτος προς ύψος.

Στις παλαιότερε εκδόσεις για να τυπώσουμε ένα σημείο έπρεπε να χρησιμοποιήσουμε την ΒΑΨΕ ή FILL η οποία υπάρχει για να φτιάχνουμε τετράπλευρα με όσο πλάτος και ύψος θέλουμε (άρα και ένα εικονοστοιχείο), με χρήση ενός ή δυο χρωμάτων, καθώς επίσης για δυο χρώματα μπορούμε να ορίσουμε αν θα αλλάζουν σε οριζόντια ή σε κάθετη διεύθυνση, και αν θα αλλάζουν ως έχουν ή αν θα αποτελούν τμήμα ενός μεγαλύτερου τετράπλευρου, αυτού της φόρμας, οπότε το χρώμα εκκίνησης και τερματισμού θα σχετίζεται με αυτό της θέσης του τετραπλεύρου. Δείτε την Βοήθεια ΒΑΨΕ για όλα αυτά (και άλλα όπως θα δείτε, μπορεί να εμφανίζει συγκεκριμένα πλαίσια των Windows αν μετά την λέξη ΒΑΨΕ ακολουθεί το @).

Το παρακάτω πρόγραμμα φτιάχνει τέσσερις σφαίρες. Οι σφαίρες έχουν σκιάσεις, και το τμήμα Sphere δέχεται σαν τέταρτη παράμετρο μια λάμδα συνάρτηση για να εφαρμοστεί σε κάθε εικονοστοιχείο. Υπάρχουν πέντε συναρτήσεις για να δούμε το αποτέλεσμα.
Η χρήση της Pset δεν είναι γρήγορη, επειδή μεσολαβεί κάποιος χρόνος ανανέωσης της οθόνης. Για το σκοπό αυτό αφενός βάζουμε το Set Fast ! ή Θέσε Γρήγορα ! όπου γίνονται λιγότερες ανανενώσεις, και αφετέρου βάζουμε τον ρυθμό ανανέωσης σε σχέση με τα γραφικά με την Refresh, (ή Ανανέωση)| στα 500ms (μισό δευτερόλεπτο).

Η τελευταία σφαίρα μπαίνει με διαφάνεια. Για να το πετύχουμε αυτό:
1. Παίρνουμε το χρώμα που ήδη υπάρχει στο σημείο που θέλουμε να γράψουμε με την Point (Σημείο)
2. Το χρώμα έρχεται με αρνητικό πρόσημο (έχει σχέση με το πώς ορίζονται τα χρώματα στη Μ2000), αλλά εδώ πρώτα το γυρνάμε σε θετικό και το βάζουμε σε ένα πρόχειρο, στην ουσία μια Διάρθρωση μνήμης που έχουμε περάσει στη  λάμδα συνάρτηση ως "κλείσιμο" (closure).
3. Στη διάρθρωση έχουμε ορίσει να διαβάζουμε Bytes. Εκτός από Double και Single, όλοι οι άλλοι αριθμοί είναι χωρις πρόσημο, έτσι σε μια θέση για Byte (Ψηφίο) βάζουμε τιμές από 0 έως 255.
4. Για να βάλουμε τιμή σε μια διάρθρωση πρέπει να δώσουμε το offset ή την σχετική διεύθυνση, με το 0 να δηλώνει το πρώτο byte. Επίσης μπορούμε να ορίσουμε αν θα βάλουμε αυτό που πρέπει δηλαδή το Byte ή αν θα δηλώσουμε ότι θα βάλουμε κάτι μεγαλύτερο, οπότε θα καλύψει και άλλα bytes. Έτσι εδώ έχουμε 8 bytes, για να βάλουμε ως Long (ως Μακρύς)  το χρώμα που πήραμε από το Σημείο, και στην θέση 4 ( θέσεις ψηφίων 4,5,6,7) θα πέσει το χρώμα που θέλουμε να βάλουμε.
5. Τη διάρθρωση τη χρησιμοποιούμε για να διαβάσουμε το κάθε ψηφίο των RGB (τα τρία πρώτα ψηφία του Μακρύ), και να βγάζουμε το μέσο όρο, και στο τέλος διαβάζουμε το νούμερο ως μακρύς (λέει as long). Όπου χρησιμοποιούμε στις διαρθρώσεις το ως κάτι για διάβασμα τότε η σχετική διεύθυνση είναι σε μέτρο ψηφίων. Εδώ η διάρθρωση είναι με μέτρο ψηφίων (bytes) για να αλλάξουμε ψηφία (bytes).




Module CheckIt {
      Form 60, 40
      Cls 0 ' Black
      Gradient 0,1
      Pen 14 ' Yellow
      Set Fast !
      Refresh 500
      Module Sphere (R as long, X0 as long, Y0 as long, fun){
            R2 = R * R
            Def Long X, Y, D2
            Let Scale=twipsx/R*13.5
            For Y = -R To R step twipsx {
            Move X0-R, Y+Y0
            For X = -R To R step twipsy {
                  D2 = X **2 + Y **2
                  IF R2>D2 THEN Pset Fun(Max.Data(Min.Data((Sqrt(R2 - D2) - ( X + Y) / 2 )*Scale ,255),0))
                  Step twipsx
            }
            }
      }
      Blue=lambda (c)->{
            c1=c/4+192
            =Color(c,c,c1)
      }
      Blue1=lambda (c)->{
            c1=c/4+Random(150,192)
            =Color(c,c,c1)
      }
      Mystery=lambda m=1 (c)->{
            c1=c/4+m
            m+=10
            if m>192 then m=1
            =Color(c,c,c1)
      }
      Mystery2=lambda m=1, p=true (c)->{
            c1=c/4+m
           if p then m+=10
           Else m=-10
            if m>192 then m-=10 : p=false
            If m<0 then m+=10: p=true
            =Color(c,c,c1)
      }
      Buffer Alfa as byte*8
      Trans =lambda Alfa (c) -> {
            Return Alfa, 0:=-point as long
            Return Alfa, 4:=-color(c,c, c/4+192) as long
            for i=0 to 2: Return Alfa, i:=(Eval(Alfa, i)+Eval(Alfa, i+4))/2: Next i
            =-Eval(Alfa, 0 as long)
      }
      Sphere 2400, 9000,7000, Blue
      Sphere 800, 6000, 7000, Blue1
      Sphere 1200, 5000,5000, Mystery
      Sphere 1200, 10000,6000, Mystery2
      Sphere 1200, 8000,5000, trans
}
Checkit





Σάββατο, 3 Νοεμβρίου 2018

FilterMap, FilterFold, Filter, Combine Functions

M2000 has a unique stack system to pass parameters. Each function executed with own stack of values, which erased at the exit. We can pass any number of parameters. Here we use optional arguments. Also we can determine the required type of nth argument from the first or an early reading argument. This happen to FilterMap, where we find if an array has numbers or strings (checking the first item only).
Functions returned type in M2000 can be anything, but we have to use $ in the name to return a string. Interpreter check quickly an expression just before the execution to find if the expression is a string expression, using the $ symbol.

FilterMap return a pointer to array
FilterFold return number, FilterFold$ return string
HasString used as closure to each of the above three functions.

We can combine function to make a bigger filter using Filter() which return function.
We can combine functions for mapping, using combine() and combine$(), one for numeric result and the other for string result. So combine() can be used in FilterFold() and combine$() can be used in FilterFold$()
We can use iterator using Each() but as we see in comments in program, we can't use it direct from expression, but only when we have a named pointer.  This happen because iterator works with a reference to pointer which points to array. This was by design, so an iterator can't work if it is a result from a function, but works fine if passed as an argument, and this happen for FilterFold and FilterMap. When iterator passed by value, it is a pointer, so this is its value. We can pass a pointer to iterator of an array or a pointer to an array. To check if we have an iterator we use Valid(), so for a w we check if Valid(w^) return true. For each iterator, the name of it plus the character "^" is the cursor (or index). So an array has no cursor/index so if a is an array valid(a^) return false. Iterator act as an array (if we read the type we get "mArray", where mArray is the object under the hood). To use iterator we have to place in a When {} structure. We can place a number of iterators, in a list like While A, B, C { } and if any of these end then the While finished. Also we can make more than one iterator for same array and use them both. if w is iterator we can advance to 2nd each time change it inside while using w=each(w, w^+2)
a=(1,2,3,4,5,6,7)
w=each(a)
while w {
      Print array(w)
      w=each(w,w^+2)
}
print
1
3
5
7



Module FilterMapFold {
      Form 80,40
      \\ HasString()
      \\ used to find if an array has strings or numbers
      \\ looking first element
      \\ because a is an iterator of array we have to copy first item
      \\ in a fresh array, which is base 0 by default
      \\ car(a) return first item as an array of one item
      \\ cdr(a) return all others as an array - not used here
      \\ (,) is the empty array - we can use Len() to check this
      HasString=Lambda (&a) ->{
            z=car(a)
            if len(z)=0 then =false :exit
            link z to s()
            =type$(s(0))="String"
      }
      \\ FilterFold$()
      \\ get an array or a pointer to array or an iterator to array
      \\ then optional get filter
      \\ then get the fold function (not optional)
      \\ then get the initial string value - optional
      \\ return string
      FilterFold$=lambda$ HasString (w)-> {
            f=lambda->true
            res$=""
            Read ? f
            Read fold, ? res$
            flush ' empty stack no other arguments allowed
            if not valid(w^) then {m=each(w)} else m=w
            if HasString(&m) then {
                  while m {
                        if not f(array$(m)) then continue
                         Call fold(array$(m), &res$)
                  }
            } else {
                  while m {
                        if not f(array(m)) then continue
                         Call fold(array(m), &res$)
                  }
            }
            =res$
      }
      \\ FilterFold()
      \\ get an array or a pointer to array or an iterator to array
      \\ then optional get filter
      \\ then get the fold function (not optional)
      \\ then get the initial number value - optional
      \\ return number
      FilterFold=lambda HasString (w)-> {
            f=lambda->true
            res=0
            Read ? f
            Read fold, ? res
            flush ' empty stack no other arguments allowed
            if not valid(w^) then {m=each(w)} else m=w
            if HasString(&m) then {
                  while m {
                        if not f(array$(m)) then continue
                         Call fold(array$(m), &res)
                  }
            } else {
                  while m {
                        if not f(array(m)) then continue
                         Call fold(array(m), &res)
                  }      
            }
            =res
      }
      \\ FilterMap()
      \\ get an array or a pointer to array or an iterator to array
      \\ check to see if is an iterator, if not make one
      \\ then optional get filter function
      \\ check if has string or number
      \\ then optional get mapfunction
      \\ return a poinrer to a new array with results
      \\ [ ] get all items from stack and return a stack object
      \\ Array([])  convert stack object to array
      FilterMap=lambda HasString (w)-> {
            if not valid(w^) then {m=each(w)} else m=w
            f=lambda->true
            if HasString(&m) then {
                  map$=lambda$->Letter$
                  Read ? f, map$
                  flush ' empty stack no other arguments allowed
                  while m {
                        if not f(array$(m)) then continue
                        data map$(array$(m))
                  }
            } Else {
                  map=lambda ->Number
                  Read ? f, map
                  flush ' empty stack no other arguments allowed
                  while m {
                        if not f(array(m)) then continue
                        data map(array(m))
                  }
            }
           =Array([])
      }
      \\ we can combine filters using filter()
      \\ we can have any number of lambda functions as parameters
      \\ if any function return false then exit and return falsa
      \\ so return true only if all functions return true
      \\ here we use it with one parameter
      \\ s is a pointer to stack object
      \\ stack(s) is a stack object as copy of s
      \\ ! stack(s)  paste all items to current stack, the lambda stack
      \\ so filter  return a lambda which works for any number and type of arguments
      \\ we use T and F as boolean values - only for print statement
      \\ because True and False are doubles, not boolean, but works nice in boolean expressions
      \\ All comparisons return boolean.
      Function filter {
            Def boolean T=True, F=False
            dim all() : all()=Array([]) : L=len(all())-1
            =lambda all(), L , F, T -> {
                s=[] : =T
                for i=0 to L { if all(i)(!stack(s)) else =F : exit
                }
            }
      }
      \\ example for two parameters
      greater=lambda (x, z)->x>z
      divided=lambda (x, z)->x mod z=0
      myfilter=filter(greater, divided)
      Print myfilter(10,2)=true, myfilter(2,10)=false, myfilter(7,3)=false
     
      \\ combine$()
      \\ take any number of lambda functions, which return string/object result
      \\ combine$() get all parameters to an array and make it  a closure in the returned lambda
      \\ stackitem$() return any type from stack (string or object), without dropping it
      \\ because function's stack always erased at the exit, it make the drop for us.
      Function combine$ {
            dim all$()
            all$()=Array$([])
            L=len(all$())-1
            =lambda$ all$(), L -> {
                for i=0 to L {Push all$(i)(![])} : =StackItem$()
            }
      }
      \\ combine(
      \\ take any number of lambda functions, which return number/object result
      \\ combine() get all parameters to an array and make it  a closure in the returned lambda
      \\ stackitem() return any type from stack (number or object), without dropping it
      \\ because function's stack always erased at the exit, it make the drop for us.
      Function combine {
            dim all()
            all()=Array([])
            L=len(all())-1
            =lambda$ all(), L -> {
                for i=0 to L {Push all(i)(![])} : =StackItem()
            }
      }
      \\ so now we see some example of using these functions
      \\ b is a pointer to array
      b=(1,2,3,4,5,6,7,8)
      \\ just  return a copy of b
      Print FilterMap(b)
      \\ we make a lambda to be used to FilterFold
      \\ second parameter has to be passed by reference
      \\  We can use FilterFolder with String Arrays or Number Arrays
      \\ but we get number  as result (from FilterFolder$ we get string)
      \\ so the reference here must be for a number
      \\ the first parameter here is number because we have number array to fold
      mul=lambda (x, &p) -> {
            p*=x
      }
      \\ using initial value 1  (default is 0, but here 0 isn't good)
      Print FilterFold(b,,mul,1)
      \\ so now we use the same number array but for string result
      \\ we make a text with one to eight starts, like a triangle of stars
      bar$=lambda$ (x, &ret$) ->{
            ret$+=string$("*", x)+{
            }
      }
      \\ Report using 2 center each line, so we get something like a tree
      \\ also report use proportional spacing
      Report 2, FilterFold$(b,,bar$) +"*"
      \\ we can make a new array adding three times b, so now b point to a new array
      b=cons(b,b,b)
      \\ we want the sum of all numbers in b
      Sum=lambda (x, &total)->{
            total+=x
      }
      \\ we leave empty the filter, we place the sum function. Initial value is 0 and this is nice here.
      Print FilterFold(b, ,Sum)
      \\ We want now to get an array of all squares of even numbers in array
      \\ so we want  the Even function as filter (return a boolean)
      \\ and the square function which return squares
      Even=lambda (x)->x mod 2=0
      Square=lambda (x)->x**2
      \\ this is the same
      Square=lambda (x) -> {
            =x**2
      }
      \\ and this is the same too
      Square=lambda -> {
            Read x
            =x**2
      }
      \\ or better , using  Number  which pop a number from lambda's stack
      Square=lambda ->Number**2
      \\ so now we get an array with all values
      Print FilterMap(b, Even, Square)
      \\ We can get the sum too easy:
      Print FilterFold(FilterMap(b, Even, Square), , sum)
      \\ Warning
      \\ Each( )can't work with expression, it need a pointer to array or an array like a()
      \\ so we use c as a pointer to array
      c=FilterMap(Each(b 1 to 8), Even, Square)
      \\ we can see items and length
      Print c, len(c)
      \\ so now we can use each(c,1,2) to get the two first items
      \\ and using FilterFold we get the sum ot those two items
      Print FilterFold(each(c,1,2), , sum)
      \\ We can use two dimensional arrays, or more (maximum ten dimensions)
      \\ we can set different base (low bound) for each dimension
      \\ Dim is always like a "Dim Preserve" in VB6
      Dim z(1 to 4, 1 to 2)
      z(1,1)=1,2,3,4,5,6,7,8
      \\ So now we pass z() to FilterFold, and this check that it has numbers
      \\ and apply the proper code to support the sum function
      Print FilterFold(z(), , sum)
      \\ no it has numbers
      Print HasString(&Z())
      \\ so now we see examples with strings in array
      a=("car","boat","cat","frog")
      \\ check that HasString() works
      Print HasString(&a) ' true
      \\ filters
      \\ check if a$ has a "t" upper or lower case
      HasAt=lambda (a$)->instr(lcase$(a$),"t")>0
      \\ check if a$ has three characters length
      IsThreeLetters=lambda (a$)->len(a$)=3
      \\ maps
      \\ convert to uppercase
      capitalize$=lambda$ (a$)->Ucase$(a$)
      \\ add "123"
      add123$=lambda$ (a$)->a$+"123"
      \\ add brackets
      addbrackets$=lambda$ (a$)->"["+a$+"]"
      \\ Using filterMap with no filter/map, so we get the first two items by each()
      Print filterMap(each(a,1,2))
      \\ now we get all items capitalize
      Print filterMap(a,,capitalize$)
      \\ now we get items with three letters capitalize
      Print filterMap(a,isThreeletters,capitalize$)
      \\  We pass a composite filter using  filter()
      \\ so now we want items with three letters and  have a "t" inside, and map to capitalize
      Print filterMap(a,filter(isThreeletters,HasAt), capitalize$)
      \\  Here we get all items with three letters an apply combine map of two functions
      \\ last function applied last
      Print filterMap(a,isThreeletters, combine$(capitalize$, add123$))
      \\  Here we get all items with three letters an apply combine map
      \\ last applied the addbrackets so we get [CAR123] [CAT123]
      Print filterMap(a,isThreeletters, combine$(capitalize$, add123$, addbrackets$))
      \\ So now we make a folding function
      \\ using string for items and by reference string for accumulator
      appendstring=lambda (x$, &all$)->{
            all$+=x$
      }
      \\ we get all items in a string without spaces
      Print FilterFold$(a,,appendstring)
      \\ we use each with no coma using "to" and Start and End (1 and -1), in reverse
      \\ so we get the items in a string in reverse order
      \\ reverse, we can use each(a, -1, 1)
      Print FilterFold$(each(a End to Start),,appendstring)
      \ like this
      Print FilterFold$(each(a,-1,1),,appendstring)
      \\ we can apply a filter
      Print FilterFold$(a,isThreeletters,appendstring)
      \\ or we can use the FilterMap() as a parameter for FilterFold$()
      Print FilterFold$(FilterMap(a,isThreeletters, combine$(capitalize$, addbrackets$)),,appendstring)
      \\ Another folding function, to get the total length, so we need number,
      \\ so we use FilterFold and not FilterFold$
      GetLength=lambda (x$, &all)-> {
            all+=len(x$)
      }
      \\ Also we can get the maximum length from items
      GetMaxLength=lambda (x$, &max)-> {
            If len(x$)>max then max=len(x$)
      }
      \\ so now we get the length from all items with three letters
      Print FilterFold(a,isThreeletters,GetLength)=6
      \\ and we get the maximum length from all items
      Print FilterFold(a,,GetMaxLength)=4
}
FilterMapFold