We can pass a number to string using += or = (or <= for global variables) . This not works for arrays of type string (maybe I fix it later).
string s
s+=100 // revision 22
print s="100" // true
s$="value:" // we can't use string s$
s$+=12.2323 // revision 22
print s$="value:12.2323"
s$=1212 // revision 22
print s$="1212"
global string k
k<=123.2343423423423432@
print k="123.2343423423423432" // true
Working on Fusc series example, I found something disturbing with my code on mstack (the stack of values). Sometime we didn't find the "useless" code, until that has a cost on performance. Here I use something which I found normal. to add an index number to the method add on a VB6 collection, to just append data (the Data statement of M2000 append data to the "end of list", while the Push statement add to the top, where we pop data, so using Push and Number we pop numbers in a LIFO manner, and using Data and Number we use the stack of values in a FIFO manner). Using the index number to place after the value cause the VB6 collection to iterate through all items; For a small number of items that isn't something to notice. But for some 100k of data this getting worse and more worse, The vb6 collection has two pointers internal to add items from the two ends of a series of data. So using the add method without index number to put after this the data means we append the data (to the right end, when left end has the first item). The add like this is with no cost O(1).
The new revision has 5 additions/fixes. So see at the Git the readme.txt
This program runs for 3.3 minutes, and 33 minutes on previous revision (before the fix).
module Fusc_sequence (level) {
class z {
boolean noStop=true
module generate(&k()) {
object q=stack:=1
call k(0)
call k(1)
stack q {
x=number:data x:call k(x)
x+=stackitem():data x:call k(x)
if .noStop then loop
}
q=stack
.noStop<=true
}
}
z=z()
long max=61, n, k=-1, m
string fmt="#,##0", fs="{0:-10} : {1}", prev
function f1(new x) {
n++
if n=1 then print "First 61 terms:":print "[";
if n<max then
print x+", ";
else.if n=max then
print x+"]"
z.noStop=false
end if
}
profiler
z.generate lazy$(&f1())
print "Points in the sequence where an item has more digits than any previous items:"
print format$(fs, "index", "value")
n=0: max=level
function f2(new x) {if x>=k then m++:k=10&**m:print format$(fs,str$(n,fmt),str$(x,fmt)):if m=max then z.noStop=false
n++}
z.generate lazy$(&f2())
print timecount
}
Fusc_sequence 5
I found a mistake on evaluator parser, and I repaired it (see readme.txt in github).
New eval2 module. This evaluator produce M2000 code as a string value and passed to INLINE statement which execute it and print the result of the evaluated expression. Although is a good expression evaluator parser, is not so good as the M2000 parser, which can do this:
z=-32768% : print type$(z)="Integer", z=-32768
The integer value -32768% exist but the 32768% not exist as integer, so we have to apply the unary minus, the negation at the literal constant, not by splitting to a positive constant (which not exist as integer), and then apply the negation. The example parser use double type (the default type) so there is no problem. However if we like to use long, or integer or long long and currency type, we have the limitation of the max positive value which isn't same as the minimum negative allowed value. Type Decimal has no such problem because the sign has own bit at the binary representation level, and an always positive value for the value. So -1 written internal as 1 bit for sign and 1 bit for value 1. An integer -1 is 0xFFFF (16 bit with value 1), so not only the most significant bit is 1 but also the value is two complements, which means we add 2 to 0xFFFF dropping the carry (module 16 addition), to get 0x0001 the actual absolute value).
Visual Basic 6 evaluator can't process this: ? 10%-32768% at the immediate window. Because the - operator isn't unary, so has to parse 32768 as integer and that value not exist. M2000 parser can parse this (the ? the Print statement in M2000 also) and return -32758. Another difference with Vb6 parser is the use of exponent operator, where any evaluation return double type. For M2000 where the base value is long, integer, long long, the result is the same type, with overflow control (raise error on overflow). The long long value (a 64bit integer, 8 bytes) has more digits than a double (8 bytes, with exponent and mantissa fields, so the exponent make mantissa with less bit from a long long, less information). The Vb6 can't handle long long values, but because has low level statements the M2000 environment which is written with Vb6 can use them.
a=10%-32768%
? type$(a)="Integer", a=-32758
b= -3%^2
? type$(b)="Integer", b=-9
b1= (-3%)^2
? type$(b1)="Integer", b1=9
c= -3%^3
? type$(c)="Integer", c=-27
The eval2 module (exist in Info.gsb, which is on the setup file). The parser return the string when the parsing ends, which maybe has some other "statements" or "clauses" to be interpreted.
module CheckEvaluator (Expr$){
class EvalAst {
private:
Function Ast(&in as string) {
string Ast, op, op1
do
in=Trim$(in)
oper$=left$(in,1)
if oper$="-" then
in=Mid$(in, 2)
op1+="push -number:"
else.if oper$="+" then
in=Mid$(in, 2)
rem op1+=":"
else
exit
end if
always
Do
Ast+=.Ast1(&in , op1): op1=""
in=Trim$(in)
oper$=left$(in,1)
if Instr("+-", oper$)>0 else exit
Ast+=op : op=""
if len(oper$)>0 then
if oper$="+" then op+="push number+number:" else op+="shift 2: push number-number:"
end if
in=Mid$(in, 2)
until len(in)=0
=Ast+op '+op1
}
Function Ast1(&in as string, op1 as string) {
string Ast, op
Ast+=.Ast2(&in, &op1)
Do
in=Ltrim$(in)
oper$=left$(in,1)
if oper$="*" then
in=Mid$(in, 2)
Ast+=.Ast2(&in, &op)
Ast+="push number*number:"+op1
op1=""
else.if oper$="/" then
in=Mid$(in, 2)
Ast+=.Ast2(&in, &op)
Ast+="shift 2:push number/number:"+op1
op1=""
else
exit
end if
until len(in)=0
=Ast
}
Function Ast2(&in as string, &op1 as string) {
string Ast, op2
integer m
Do
Do
in=Trim$(in)
oper$=left$(in,1)
if oper$="-" then
in=Mid$(in, 2)
op1+="push -number:"
else.if oper$="+" then
in=Mid$(in, 2)
rem op1+=":"
else
exit
end if
always
Ast+=.Ast3(&in)
m++
in=Trim$(in)
oper$=left$(in,1)
if m>1 then
Ast+="shift 2:push number^number:"
if oper$<>"^" then Ast+=op1: op1=""
end if
oper$=left$(in,1)
if oper$="^" else exit
in=ltrim$(Mid$(in, 2))
oper$=left$(in,1)
if oper$="" then exit
if Instr("-+", oper$)>0 then
op2=""
do
in=ltrim$(Mid$(in, 2))
if oper$="-" then op2+="push -number:"
oper$=left$(in,1): if oper$="" then exit
when Instr("-+", oper$)>0 and len(oper$)>0
Ast+=.Ast2(&in, &op2)+op2+"shift 2:push number^number:"
op2=""
exit
end if
until len(in)=0
=Ast+op1: op1=""
}
Function Ast3(&in as string) {
in=Trim$(in)
if Asc(in)<>40 then =.GetNumber(&in) : exit
in=Mid$(in, 2)
=.Ast(&in)
in=Mid$(in, 2)
}
Function GetNumber (&in as string) {
string ch, num
boolean once
Do
ch=left$(in,1)
if once then
if instr("0123456789", ch)>0 else exit
else
if instr(".0123456789", ch)>0 else exit
if ch="." then once=true
end if
num+=ch
in=Mid$(in, 2)
until len(in)=0
if num="." then Error "missing number"
if len(num)=0 then =stack: exit
="push "+num+":"
}
public:
value () {
=.Ast(![])+"Print number"
}
}
Ast=EvalAst()
print "Evaluation using Eval():";
Pen 11 {print expr$+"="+ eval(expr$)}
r$=Ast(&Expr$)
print " Remain:"+Expr$
print " ";
Report r$, width-pos*2
print @(0),
Print " Result :";
Pen 15 {inline r$}
}
CheckEvaluator "-2^-3^-4"
CheckEvaluator "-2^(-3)^-4"
CheckEvaluator "-2^2-2^2"
CheckEvaluator "(-2.5)^2"
CheckEvaluator "(-2)^3"
CheckEvaluator "(-(2))^3"
CheckEvaluator "--++--3.45"
CheckEvaluator "(-((-(4)))) alfa"
CheckEvaluator "1+2 * (3 + ( 2 ^ 2 * 5 + 6 * 7 * 2^3) - 9) / 10"
CheckEvaluator "-10*-2/-3*-5"
CheckEvaluator "-10*-(2/-3*-5)"
CheckEvaluator "2/3/4"
checkevaluator "-2/3^(3*4)"
CheckEvaluator "-(2/2)^(3*-4)"
CheckEvaluator "-2/(3)^(3*-4)"
CheckEvaluator "-2/(2)^-12"
Update2: More compact code! Removed class, and we have only one function AST() which have two subroutines. Subs in M2000 may change the stack of values, which is the same as the one in the module/function from where we call it. A stack Op { } block put temporary the Op object as current stack and after the exit from the block we get the old untouched stack. (the "original" stack of function never exposed as a pointer to get it as stack object. There is th [] read only variable which get the pointer of current stack and leave an empty stack. So to get the current stack as object we have to swap it with an empty one. so k=[] get the current object to K, and stack K move all items to current stack at the end, so K now is a pointer to an empty stack. Stack New { } is a block which pass an empty stack as current stack, and hold old one, without using variable, and at the exit the old one released as current stack.
Update1: Now Evaluator works fine (will be update in INFO on revision 20). Expressions like 2*-(3) (unary sign after mul/div and then parenthesis).
Evaluator for expressions now use the unary + (identity). Also fixed the error (-2)^2 which now return 4 (not -4). Also some commands like Open, Input, Clipboard can work with string variables without suffix $/ (I am working to fix all the commands)
I add the Evaluator module (the code is bellow). I make this tool to adjust the M2000 evaluator (which is way different from this). So this evaluator get an expression and produce a list of numbers and symbols as RPN (Reverse Polish Notation), using unary - +, and ^, *, /, +, - and parenthesis ( ), and numbers (could be floating point too). The list is a stack object which have fields for numbers and strings (stack objects can hold anything including objects, they have a Vb6 collection object inside). We can process that list to calculate the result. Also there is a function which get the string representation of stack item (we can do that making a copy and then use that copy to produce an array, and that array can be stringify using #str$() function - see code bellow).
This is the output of the program:
Need version 12 revision 19
form 96, 82
Module CheckEvaluator (Expr$) {
function rpn_to_infix$(a$) {
def m=0
inventory precedence="-":=2,"+":=2,"*":=3,"/":=3,"u-":=4, "u+":=4, "^":=5
dim token$()
token$()=piece$(a$," ")
l=len(token$())
dim type(l)=0, right(l)=0, infix$(l)
infix=-1
for i=0 to l-1
if exist(precedence, token$(i)) then
type(i)=precedence(token$(i))
if type(i)>=4 then right(i)=-1
end if
if type(i)=0 then
infix++
infix$(infix)=token$(i)
type(infix)=100
else
if right(i) then
if type(i)=5 then
if type(infix)<type(i) then infix$(infix)="("+infix$(infix)+")"
if type(infix-1)<100 then infix$(infix-1)="("+infix$(infix-1)+")"
infix$(infix-1)=infix$(infix-1)+token$(i)+infix$(infix)
else.if token$(i)="u-" then
infix$(infix)="-"+infix$(infix)
infix++
else
infix$(infix)="+"+infix$(infix)
infix++
end if
else
if type(infix)<type(i) then infix$(infix)="("+infix$(infix)+")"
if type(infix-1)<type(i) then
infix$(infix-1)="("+infix$(infix-1)+")"+token$(i)+infix$(infix)
else
infix$(infix-1)=infix$(infix-1)+token$(i)+infix$(infix)
end if
end if
type(infix-1)=type(i)
infix--
end if
next i
=infix$(0)
}
Function Ast(&in$) {
flush
Ast()
=[]
sub Ast()
Local op=stack
do
Ast1()
do
in$=Ltrim$(in$)
oper$=left$(in$,1)
if oper$="*" then
in$=Mid$(in$, 2)
Ast1()
data "*"
else.if oper$="/" then
in$=Mid$(in$, 2)
Ast1()
data "/"
else
exit
end if
until len(in$)=0
in$=Trim$(in$)
oper$=left$(in$,1)
if Instr("+-", oper$)>0 else exit
stack op
if len(oper$)>0 then stack op {data oper$}
in$=Mid$(in$, 2)
until len(in$)=0
stack op
End sub
Sub Ast1()
local object op1=stack
local integer m
do
do
in$=Trim$(in$)
oper$=left$(in$,1)
if oper$="-" then
in$=Mid$(in$, 2)
stack op1 {push "u-"}
else.if oper$="+" then
in$=Mid$(in$, 2)
stack op1 {push "u+"}
else
exit
end if
always
in$=Trim$(in$)
if Asc(in$)<>40 then
string ch="", num=""
boolean once=false
do
ch=left$(in$,1)
if once then
if instr("0123456789", ch)>0 else exit
else
if instr(".0123456789", ch)>0 else exit
if ch="." then once=true
end if
num+=ch
in$=Mid$(in$, 2)
until len(in$)=0
if num="." then Error "missing number"
if len(num)=0 then =stack: exit
data val(num)
else
in$=Mid$(in$, 2)
Ast()
in$=Mid$(in$, 2)
end if
m++
in$=Trim$(in$)
oper$=left$(in$,1)
if m>1 then
data "^"
if oper$<>"^" then stack op1
end if
if oper$="^" else exit
in$=ltrim$(Mid$(in$, 2))
oper$=left$(in$,1)
if Instr("-+", oper$)>0 then
Ast1()
data "^"
exit
end if
until len(in$)=0
stack op1
end sub
}
Pen 15 {
Pen 12 {print "input expression:";}
Pen 14 {print Expr$}
print "Result through eval$:";
pen 10 {print eval(Expr$)}
mres=Ast(&Expr$)
print "computed RPN :";array(stack(mres))#str$()
MM$=rpn_to_infix$(array(stack(mres))#str$())
print "cumputed INFIX :";rpn_to_infix$(array(stack(mres))#str$())
print "Using Eval$() on infix:";eval(MM$)
pen 11 {
Print "Compute RPN value:";
}
reg=stack
mm=each(mres)
while mm
if stacktype$(mm)="String" then
stack reg {
select case stackitem$(mm)
case "+"
push number+number
case "-"
shift 2:push number-number
case "*"
push number*number
case "/"
shift 2: push number/number // shift 2 swap top 2 values
case "^"
shift 2:push number**number
case "u-"
push -number
end select
}
else
stack reg {push stackitem(mm)}
end if
end while
if len(reg)<>1 then Error "Wrong Evaluation" else pen 10 { print stackitem(reg)}
}
}
cls
Report{INFIX to RPN to INFIX example - Compute value for RPN through flat list (as stack object)
Symbols: + - * / ^ ( ) 0 1 2 3 4 5 6 7 8 9 .
Precedence (high to low): Exponentiation (^), unary identity (+) and negation (-), Multiplication (*)and Division (/), Addition (+) and Subtraction (-)
}
CheckEvaluator "-2^+3^-4"
CheckEvaluator "-2^-3^-4"
CheckEvaluator "-2^(-3)^-4"
CheckEvaluator "-2^2-2^2"
CheckEvaluator "-2^3-2^3"
CheckEvaluator "(-2.5)^2"
CheckEvaluator "(-2)^3"
CheckEvaluator "(-(2))^3"
CheckEvaluator "--++--3.45"
CheckEvaluator "1+2 * (3 + ( 2 ^ 2 * 5 + 6 * 7 * 2^3) - 9) / 10"
CheckEvaluator "2/3/4"
CheckEvaluator "2*-(3)/-4*(-5)+--3"
Using a Permutation Step Function:
Module Dinesman_s_multiple_dwelling_problem {
// this is the standard perimutation function
// which create a lambda function:
// pointer_to_array=Func(&BooleanVariable)
// when BooleanVariable = true we get the last permutation
Function PermutationStep (a as array) {
c1=lambda (&f, a) ->{
=a : f=true
}
integer m=len(a)
if m=0 then Error "No items to make permutations"
c=c1
While m>1
c1=lambda c2=c,p=0%, m=(,) (&f, a, clear as boolean=false) ->{
if clear then m=(,)
if len(m)=0 then m=a
=cons(car(m),c2(&f, cdr(m)))
if f then f=false:p++: m=cons(cdr(m), car(m)) : if p=len(m) then p=0 : m=(,):: f=true
}
c=c1
m--
End While
=lambda c, a (&f, clear as boolean=false) -> {
=c(&f, a, clear)
}
}
boolean k
object s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
StepA=PermutationStep(s)
while not k
s=StepA(&k)
if s#val$(4)= "Baker" then continue
if s#val$(0)="Cooper" then continue
if s#val$(0)="Fletcher" then continue
if s#val$(4)="Fletcher" then continue
if s#pos("Cooper")> s#pos("Miller") then continue
if abs(s#pos("Smith")-s#pos("Fletcher"))=1 then continue
if abs(s#pos("Cooper")-s#pos("Fletcher"))=1 then continue
exit // for one solution
end while
object c=each(s)
document doc$={ Dinesman's multiple-dwelling problem
Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors.
• Baker does not live on the top floor.
• Cooper does not live on the bottom floor.
• Fletcher does not live on either the top or the bottom floor.
• Miller lives on a higher floor than does Cooper.
• Smith does not live on a floor adjacent to Fletcher's.
• Fletcher does not live on a floor adjacent to Cooper's.
Where does everyone live?
Solution:
}
while c
doc$={ •}+array$(c)+" lives on floor "+(c^+1)+{
}
end while
report doc$
clipboard doc$
}
Dinesman_s_multiple_dwelling_problem
Using Amp Function (Which use a failure function for a series of arrays, each one for each argument on the failure function). For this example this function find 1200 different sets of parameters for testing on the failure function. Need 5sec on my compute. The previous program need less than a half second, because there are only 120 permutations for 5 names (!5= 5*4*3*2=120).
Module Using_AmbFunction {
Enum Solution {First, Any=-1}
Function Amb(way as Solution, failure) {
read a
c1=lambda i=0, a, (&any, &ret) ->{
any=(array(a,i),)
ret=any
i++
ok=i=len(a)
if ok then i=0
=ok
}
m=stack.size
if m=0 then Error "At least two arrays needed"
c=c1
while m>0 {
read a
c1=lambda c2=c, i=0, a, (&any, &ret) ->{
any=(array(a,i),)
ret=(,) : ok=false : anyother=(,)
ok=c2(&anyother, &ret)
ret=cons(ret, any)
if ok then i++
ok=i=len(a)
if ok then i=0
=ok
}
c=c1 : m--
}
ok=false
any=(,)
flush
while not ok
ret=(,)
ok=c(&any, &ret)
s=stack(ret)
if not failure(! s) then data ret : if way>0 then ok=true
End While
if empty then
ret=(("",),)
else
ret=array([])
end if
=ret
}
Range=lambda (a, f) ->{
for i=a to f-1: data i: next
=array([])
}
Baker=range(1, 5)
Cooper=range(2, 6)
Fletcher=range(2, 5)
Miller=range(1,6)
Smith=range(1,6)
failure=lambda (Baker, Cooper, Fletcher, Miller, Smith)->{
if Baker=Cooper or Baker=Fletcher or Baker=Miller or Baker=Smith then =true:exit
if Cooper=Fletcher or Cooper =Miller or Cooper=Smith then =true:exit
if Fletcher=Miller or Fletcher=Smith or Miller=Smith then =true:exit
if Miller<Cooper or abs(Cooper-Fletcher)=1 or abs(Smith-Fletcher)=1 then =true:exit
}
all=amb(Any, failure, Baker, Cooper, Fletcher, Miller, Smith)
k=each(all)
s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
while k
z=array(k)
zz=each(z, , -2)
while zz
? s#val$(zz^)+" ("+array(zz)+"), ";
end while
zz=each(z, -1)
while zz
? s#val$(zz^)+" ("+array(zz)+") "
end while
end while
}
Using_AmbFunction
