Ooops
July 28, 2021, 00:02:47

Author Topic: Knight Tour  (Read 184 times)

Offline jsalai

  • Jr. Member
  • **
  • Posts: 23
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 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
I won't belong to any organization that would have me as a member.
[Groucho Marx]

Offline chrisws

  • Jr. Member
  • **
  • Posts: 94
    • SmallBASIC
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.

Offline jsalai

  • Jr. Member
  • **
  • Posts: 23
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

Thanks for your kind attention!
« 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]

Offline bplus

  • Full Member
  • ***
  • Posts: 211
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! :)

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal