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

Revision 5 Version 9.5 and a URL Parser

Revision 5 of Version 9.5 is ready.

We can make a variable, named member here, as atype and optional we can provide a value.

Class Alfa {
      Enum atype {one, two, three}
      member as atype =two
}
a=Alfa()
Print a.member=a.two ' true

if we make another enum in module we can assign value to member, and internal a check happen if the value of external enum exist in internal enum.


Also I improve the speed of interpreter, and I make a better handling of out of order execution of statements for a thread from another thread. A thread running knowing the "owner", the output object. So if we make a thread in a layer, say a form layer, then all output (print and graphics) directed to that form layers.



This is the parser for rosettacode.org, including a sub for making a document for produce the output at clipboard

Module checkit {
      document doc$
      any=lambda (z$)->{=lambda z$ (a$)->instr(z$,a$)>0}
      one=lambda (z$)->{=lambda z$ (a$)->z$=a$}
      number$="0123456789"

      series=Lambda -> {
                  func=Array([])
                  =lambda func (&line$, &res$)->{
                        if line$="" then exit
                        k=each(func)
                        def p=0,ok as boolean
                        while k {
                              ok=false : p++ : f=array(k)
                              if not f(mid$(line$,p,1)) then exit
                              ok=true
                        }
                        if ok then res$=left$(line$, p) : line$=mid$(line$, p+1)
                        =ok
                  }
      }

      is_any=lambda series, any (c$) ->series(any(c$))
      is_one=lambda series, one (c$) ->series(one(c$))
      Is_Alpha=series(lambda (a$)-> a$ ~ "[a-zA-Z]")
      Is_digit=series(any(number$))
      Is_hex=any(number$+"abcdefABCDEF")

      optionals=Lambda -> {
                  func=Array([])
                  =lambda func (&line$, &res$)->{
                        k=each(func)
                        def ok as boolean
                        while k {
                              f=array(k)
                              if f(&line$,&res$) then ok=true : exit
                        }
                        =ok
                  }
      }
      repeated=Lambda (func)-> {
                  =lambda func (&line$, &res$)->{
                        def ok as boolean, a$
                        res$=""
                        do {
                              sec=len(line$)
                              if not func(&line$,&a$) then exit
                              res$+=a$
                              ok=true
                        } until line$="" or sec=len(line$)
                        =ok
                  }
      }

      oneAndoptional=lambda (func1, func2) -> {
            =lambda func1, func2 (&line$, &res$)->{
                              def ok as boolean, a$
                              res$=""
                              if not func1(&line$,&res$) then exit
                              if func2(&line$,&a$) then res$+=a$
                              =True
                        }      
      }
      many=Lambda -> {
                  func=Array([])
                  =lambda func (&line$, &res$)->{
                        k=each(func)
                        def p=0,ok as boolean, acc$
                        oldline$=line$
                        while k {
                              ok=false
                              res$=""
                              if line$="" then exit
                              f=array(k)
                              if not f(&line$,&res$) then exit
                              acc$+=res$
                              ok=true
                         }
                        if not ok then {line$=oldline$} else res$=acc$
                        =ok
                  }
      }
      is_safe=series(any("$-_@.&"))
      Is_extra=series(any("!*'(),"+chr$(34)))
      Is_Escape=series(any("%"), is_hex, is_hex)
      \\Is_reserved=series(any("=;/#?: "))
      is_xalpha=optionals(Is_Alpha, is_digit, is_safe, is_extra, is_escape)
      is_xalphas=oneAndoptional(is_xalpha,repeated(is_xalpha))
      is_xpalpha=optionals(is_xalpha, is_one("+"))
      is_xpalphas=oneAndoptional(is_xpalpha,repeated(is_xpalpha))
      Is_ialpha=oneAndoptional(Is_Alpha,repeated(is_xpalphas))
      is_fragmentid=lambda is_xalphas (&lines$, &res$) -> {
            =is_xalphas(&lines$, &res$)
      }
      is_search=oneAndoptional(is_xalphas, repeated(many(series(one("+")),is_xalphas)))
      is_void=lambda (f)-> {
            =lambda f (&oldline$, &res$)-> {
                  line$=oldline$
                  if f(&line$, &res$) then {oldline$=line$ } else res$=""
                  =true
            }
      }
      is_scheme=is_ialpha
      is_path=repeated(oneAndoptional(is_void(is_xpalphas), series(one("/"))))
      is_uri=oneAndoptional(many(is_scheme, series(one(":")), is_path), many(series(one("?")),is_search))
      is_fragmentaddress=oneAndoptional(is_uri, many(series(one("#")),is_fragmentid ))

      data "foo://example.com:8042/over/there?name=ferret#nose"
      data "urn:example:animal:ferret:nose"
      data "jdbc:mysql://test_user:ouupppssss@localhost:3306/sakila?profileSQL=true "
      data "ftp://ftp.is.co.za/rfc/rfc1808.txt"
      data "http://www.ietf.org/rfc/rfc2396.txt#header1"
      data "ldap://[2001:db8::7]/c=GB?objectClass=one&objectClass=two"
      data "mailto:John.Doe@example.com"
      data "tel:+1-816-555-1212"
      data "telnet://192.0.2.16:80/"
      data "urn:oasis:names:specification:docbook:dtd:xml:4.1.2"

      while not empty {
            read What$
           
            pen 15 {
                  Print(What$)
            }
            a$=""
            If is_scheme(&What$, &a$) Then Print( "Scheme="+a$ ): What$=mid$(What$,2)
            If is_path(&What$, &a$) Then {
                  count=0
                  while left$(a$, 1)="/" { a$=mid$(a$,2): count++}
                  if count>1 then {
                        domain$=leftpart$(a$+"/", "/")
                        a$=rightpart$(a$,"/")
                        if domain$<>"" Then Print( "Domain:"+Domain$)
                        if a$<>"" Then Print("Path:"+a$)
                  } else.if left$(What$,1) =":" then {
                        Print( "path:"+a$+What$): What$=""
                  } Else Print("Data:"+ a$)

            }

            if left$(What$,1) =":" then {
                  is_number=repeated(is_digit)
                  What$=mid$(What$,2): If is_number(&What$, &a$) Then Print("Port:"+a$)
                  if not left$(What$,1)="/" then exit
                  If is_path(&What$, &a$) Then {
                        while left$(a$, 1)="/" { a$=mid$(a$,2)}
                        if a$<>"" Then Print("Path:"+a$)
                  }
            }
            if left$(What$, 1)="?" then {
                        What$=mid$(What$,2)
                        If is_search(&What$, &a$) Then {
                        v$=""
                        if left$(What$, 1)="=" then {
                              What$=mid$(What$,2)
                              If is_search(&What$, &v$) Then Print("Query:"+a$+"="+v$)
                        }  else Print("Query:"+a$)
                        }
            }
            While left$(What$, 1)="#"  {
            What$=mid$(What$,2)
            if not is_xalphas(&What$, &a$) Then exit
            Print( "fragment:"+a$)
            }
            if What$<>"" Then print("Data:"+ What$)
      }
      clipboard doc$
      Sub Print(a$)
            print a$
            doc$=a$+{
            }
      End Sub
}
Checkit



Παρασκευή, 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