 July 28, 2021, 00:02:47

### Author Topic: Knight Tour  (Read 184 times)

#### jsalai ##### Knight Tour
« on: July 20, 2021, 14:06:39 »
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.

Code: [Select]
`' 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 startenddefinekey 27, quitlabel startcolor 15,0while 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  wendwendstopsub 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  pauseend`
I won't belong to any organization that would have me as a member.
[Groucho Marx]

#### chrisws

• Jr. Member
•  • Posts: 94 ##### Re: Knight Tour
« Reply #1 on: July 21, 2021, 11:52:23 »
Ha - that's pretty cool. With a few changes to make it run in a loop, it looks like some weird machine.

#### jsalai ##### Re: Knight Tour
« Reply #2 on: July 21, 2021, 15:07:49 »
Ha - that's pretty cool. With a few changes to make it run in a loop, it looks like some weird machine.

Thanks!
If you find it worth, you may include it to repository...

About the loop... It was my intention, but as for some starting poits it may be a pain to wait for a solution.
eg: 60x60,1,1 stucks around 2760/3600 (if I remember well), but with 60x60,3,3 it start practically instant.
so I left it to the user to interrupt the process and choose some other starting point.

I have some variants of the program which find ALL solutions but, as you may see, it may work ONLY for small boards (not necessary square), because of enormous number of solutions:

Quote
'Warnsdorff's rule, 1823. For 5 - 9 square boards there are
'1,728;6637920;165575218320;19591828170979904 solutions, respective

« Last Edit: July 21, 2021, 15:34:00 by jsalai »
I won't belong to any organization that would have me as a member.
[Groucho Marx]

#### bplus ##### Re: Knight Tour
« Reply #3 on: July 23, 2021, 20:13:46 »
I think this one even nicer than one I saw recently in QB64 that blew my version away! 