...now you can optimize the next one

Michael
Code: Select all
OpenFile(1,"e:\names.txt")
a$=ReadString(1)
a$=Mid(a$,2,Len(a$)-1);remove first "
CloseFile(1)
Dim b$(5165)
c=0
t$=""
Repeat
z$=Left(a$,1)
a$=Mid(a$,2,Len(a$)-1)
If z$<>","
t$+z$; keep adding letters until find ,
EndIf
If z$=","
c+1
b$(c)=Left(t$,Len(t$)-1);remove " from end
t$=""
a$=Mid(a$,2,Len(a$)-1);remove first "
EndIf
Until a$=""
ReDim b$(c)
SortArray(b$(),0);is this the problem?
rt=0
For n=1 To c
t=0
a$=b$(n)
For m=1 To Len(a$)
q=Asc(Mid(a$,m,1))-64;add up letters
t+q
Next
rt=rt+t*n;running total + value*position
Next
Debug rt
For n=935 To 940
Debug Str(n)+" "+b$(n)
Next
Debug "0="+b$(0)
Debug "1="+b$(1)
Debug "last="+b$(c)
Code: Select all
zeile.s=""
wort.s=""
If ReadFile(0,"Euler-P42.txt")
zeile=ReadString(0)+","
CloseFile(0)
EndIf
s=0
l=0
Repeat
k=FindString(zeile,",",l+1)
If k
wort=Mid(zeile,l+2,k-l-3)
l=k
;
;
EndIf
Until k=0
Code: Select all
Dim a(1001,1001)
a(501,501)=1
x=502
y=501
c=2
st=2
Repeat
For n=1 To st;down
a(x,y)=c
c+1
y=y+1
Next
y=y-1
x=x-1
For n=1 To st;left
a(x,y)=c
c+1
x=x-1
Next
x=x+1
y=y-1
For n=1 To st;up
a(x,y)=c
c+1
y=y-1
Next
y=y+1
x=x+1
For n=1 To st;right
a(x,y)=c
c+1
x=x+1
Next
st=st+2
Until c=1002002
t=0
For n=1 To 1001
t=t+a(n,n)
t=t+a(n,1002-n)
Next
t=t-1
Debug t
Code: Select all
x=1001
d1=0 : d2=0
For i=1 To x>>1
ro=(i*2+1)*(i*2+1)
lo=ro-i-i
ru=(i+i)*(i+i)-i-i+1
lu=ru+i+i
d1+lu+ro
d2+lo+ru
Next i
ShowResult(1+d1+d2);