A completely useless program. Today is the International Chess Day, 20th of July.

in fact a program written about 2017... and because I never comment my programs, please, don't ask me how it works.

It heavily use both static, dynamic and nested arrays.

`' Knight tour - hibrid algo - jsalai - thanks to all who may think`

' there are parts of their work(s)!

' Initially the problem of the Chess Knight on Chess Board 8x8,1,1

'Warnsdorff's rule, 1823. For 5 - 9 square boards there are

'1,728;6637920;165575218320;19591828170979904 solutions, respective

'This program finds only one - a hybrid algorithm thanks for many - and me...

'I could use recursion, but that would significantly slow down the work

'for bigger boards.

'the minimal are 3x7(7x3) or 4x5(5x4) - not for all starting points

'but you may try boards up to 50x50,1,1 (if your display supports it

'- worked fine on my android phone). On a PC it may go up to 150x90 or even more

'depending on memory size and/display.

'If the program stucks, it try to undo the moves until it finds a solution

'using dynamic nested arrays...

'Sometimes it get stuck near to end then it may take a long tine to get back

'In such cases you may try with <Esc> and another starting point (eg 60x60,3,3)

'

'Note: when it starts to display, all the work is already done!

'

sub quit

cls

?"Interrupted! Press Enter"

pause

goto start

end

definekey 27, quit

label start

color 15,0

while 1

cls

input "Board-width(x):",x0

if x0=0 then end

input "Board-height(y):",y0

if y0=0 then y0=x0

z1=xmax\(x0+1)

z2=ymax\(y0+1)

z=iff(min(z1,z2)<50,min(z1,z2),50)

input "x-Start[1-"+x0+"]:",x

input "y-Start[1-"+y0+"]:",y

x=iff(x>0,x-1,0)

y=iff(y>0,y-1,0)

nn=x0*y0

n=0

dim b(x0-1,y0-1),u

dx=[1,2,-1,-2,-2,-1,1,2]

dy=[2,1,2,1,-1,-2,-2,-1]

dim w

while n<nn

n++

b(x,y)=n

dim u

for q=0 to 7

xc=x+dx(q)

yc=y+dy(q)

if xc>=0 && yc>=0 && xc<x0 && yc<y0 && !b(xc,yc)

if n=nn-1

b(xc,yc)=n+1

displ

exit loop

else

nm=0

for r=0 to 7

xt=xc+dx(r)

yt=yc+dy(r)

b(xc,yc)=1

if xt>=0 && yt>=0 && xt<x0 && yt<y0 && !b(xt,yt) then nm++

b(xc,yc)=0

next

if nm

u << [n+1,nm,xc,yc]

fi

fi

fi

next

if len(u)

sort u

for i=ubound(u) to 0 step -1

if u(i)(1)>u(0)(1) then delete u,i

next

x=u(0)(2)

y=u(0)(3)

delete u,0

if len(u)

w << u

fi

else

if len(w)

u=w(ubound(w))

delete w,ubound(w)

while n>=u(0)(0)

c=(n in b)-1

x=c\y0

y=c%y0

b(x,y)=0

n--

wend

x=u(0)(2)

y=u(0)(3)

delete u,0

if len(u)

w << u

fi

else

?"No solution!"

exit loop

fi

fi

wend

wend

stop

sub displ

cls

dim v

for i=0 to y0

line z,i*z+z,x0*z+z,i*z+z

next

for i=0 to x0

line i*z+z,z,i*z+z,y0*z+z

next

for n=1 to nn

c=(n in b)-1

x=c\y0+1

y=c%y0+1

if n=1

xx=x

yy=y

fi

xd=x-xx

yd=y-yy

v << chr(x+64)+y

rect z*x+z\4,z*(y0-y+1)+z\4,step z\2,z\2,5 filled

circle (x+0.5)*z,(y0-y+1.5)*z,2 filled

if n>1

line (x+0.5)*z,(y0-y+1.5)*z,step -xd*z,yd*z

fi

delay 30

xx=x

yy=y

next

pause

locate ((y0+2)*z)\txth("A"),0

?v

pause

?b

pause

end