Need help with pathfinding

General FreeBASIC programming questions.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Need help with pathfinding

Post by duke4e »

Hey,

I'm working on a brand new grid based game, and I need some help. I'm searching for algorithm (or code) that can iterate through all possible paths between point A and point B on a 6x6 grid (taking into account to not walk through empty squares). So this isn't a shortest path pathfinding problem, but an all paths pathfinding problem.

Is this the solution to my problem? http://en.wikipedia.org/wiki/Breadth-first_search
If yes, then how to apply this algorithm to 2D grid?

Here is a little code snippet showing my problem:

Code: Select all

#include "fbgfx.bi"
Using FB
Randomize Timer

Const As Integer gridSize = 50
Const As Integer gridSizeHalf = gridSize / 2
Const As Integer gridX = 6
Const As Integer gridY = 6
Const As Integer xres = gridSize * gridX
Const As Integer yres = gridSize * gridY
Const As Integer midx = xres / 2
Const As Integer midy = yres / 2
Const As Single Pi = Atn(1) * 4
Const As Single TwoPi = Atn(1) * 8
Const As Single RAD = Pi / 180
Const As Single DEG = 180 / Pi

Dim Shared As Integer valueGrid(gridX, gridY)
Dim Shared As Integer x1, y1, x2, y2

Function randINT(first As Integer, last As Integer) As Integer
    Function = Cint(Rnd * (last - first) + first)
End Function

Sub CenterText(text As String, xx As Integer, yy As Integer)
    Dim As Integer xOff = Len(text) * 4
    Draw String ((xx - xOff) + 2, yy - 3), text, Rgb(0, 0, 0)
End Sub

Sub InitGrid()
    For x As Integer = 0 To gridX - 1
        For y As Integer = 0 To gridY - 1
            valueGrid(x, y) = 1
        Next
    Next
    
    For i As Integer = 1 To 5
        valueGrid(randINT(0, gridX - 1), randINT(0, gridY - 1)) = 0
    Next
    
    Do
        x1 = randINT(0, gridX - 1)
        y1 = randINT(0, gridY - 1)
        x2 = randINT(0, gridX - 1)
        y2 = randINT(0, gridY - 1)
    Loop Until ((x1 <> x2) Or (y1 <> y2)) And valueGrid(x1, y1) = 1 And valueGrid(x2, y2) = 1
End Sub

Sub RenderGrid()
    Dim As Integer xx, yy
    For x As Integer = 0 To gridX - 1
        xx = x * gridSize
        For y As Integer = 0 To gridY - 1
            yy = y * gridSize
            If valueGrid(x, y) = 1 Then Line(xx, yy)-(xx + gridSize, yy + gridSize), Rgb(255, 255, 255), bf
            Line(xx, yy)-(xx + gridSize, yy + gridSize), Rgb(200, 200, 200), b
        Next
    Next
    CenterText("A", x1 * gridSize + gridSizeHalf, y1 * gridSize + gridSizeHalf)
    CenterText("B", x2 * gridSize + gridSizeHalf, y2 * gridSize + gridSizeHalf)
End Sub

Screenres xres, yres, 32
Color Rgb(255, 255, 255), Rgb(100, 100, 100)
InitGrid()
Do
    Screenlock
    Cls
    RenderGrid()
    Screenunlock
    Sleep 5
Loop Until Multikey(SC_ESCAPE)
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

Code: Select all

'' ------------------------------------------------------------------
'' A* Demonstration using Manhattan Distance Hueristic
'' by coderJeff - November 2007
'' ------------------------------------------------------------------
''
'' The intent of this demonstration was to provide a sample program that 
'' displays results similar to "A* Pathfinding for Beginners" tutorial 
'' by Patrick Lester, found at:
'' http://www.policyalmanac.org/games/aStarTutorial.htm
''
'' Compiled using FreeBASIC 0.18.3 - however, early versions of FreeBASIC
'' should work.
''
''
'' INSTRUCTIONS
'' ------------
'' LEFT mouse button to set the starting tile
'' RIGHT mouse button to set the ending tile
'' MIDDLE mouse button to toggle the solid tiles
'' ESCAPE key to exit
''
'' ------------------------------------------------------------------

#include once "fbgfx.bi"

const TRUE = -1
const FALSE = 0
const NULL = 0

const SCREEN_W = 640
const SCREEN_H = 480

const CELL_SIZE_W = 48
const CELL_SIZE_H = 48

const CELL_W = SCREEN_W \ CELL_SIZE_W
const CELL_H = SCREEN_H \ CELL_SIZE_H

const CELL_COUNT = CELL_W * CELL_H

#define CELLINDEX(x,y) ((CELL_W*(y))+(x))

const STATE_NONE = 0
const STATE_OPEN = 1
const STATE_CLOSED = 2

''
type Cell
  '' Cell Properties
  x as integer
  y as integer
  IsSolid as integer

  '' Information needed for A* computation
  parent as Cell Ptr
  state as integer
  f as integer
  g as integer
  h as integer
end type

''
dim shared Map(0 to CELL_COUNT - 1) as CELL
dim shared StartIndex as integer
dim shared StartCell  as Cell ptr
dim shared EndIndex   as integer
dim shared EndCell    as Cell ptr
dim shared fnt        as fb.image ptr

'' ------------------------------------------------------------------
'' CELLS
'' ------------------------------------------------------------------

''
sub CellClearAll()
  for y as integer = 0 to CELL_H - 1
    for x as integer = 0 to CELL_W - 1
      with Map( CELLINDEX(x,y) )
        .x = x
        .y = y
        .IsSolid  = FALSE
      end with
    next
  next
end sub

''
sub CellSetSolid( byval x as integer, byval y as integer, byval flag as integer )
  dim n as integer = CELLINDEX(x,y)
  Map( n ). IsSolid = flag
end sub

''
sub CellSetStart( byval x as integer, byval y as integer )
    StartIndex = CELLINDEX(x,y)
    StartCell = @Map( StartIndex )
end sub

''
sub CellSetEnd( byval x as integer, byval y as integer )
    EndIndex = CELLINDEX(x,y)
    EndCell = @Map( EndIndex )
end sub

''
sub CellToggleSolid( byval x as integer, byval y as integer )
    with Map( CELLINDEX(x,y) )
        if( .IsSolid ) then
            .IsSolid = FALSE
        else
            .IsSolid = TRUE
        end if
    end with
end sub

'' ------------------------------------------------------------------
'' DISPLAY
'' ------------------------------------------------------------------

''
function CreateNumberFont() as fb.image ptr

    dim fontdata as zstring ptr = @ _
    " XXXXX  XX   XXXXX XXXXX X   X XXXXX XXXXX XXXXX XXXXX XXXXX" _
    " X   X   X       X     X X   X X     X         X X   X X   X" _
    " X   X   X   XXXXX XXXXX XXXXX XXXXX XXXXX     X XXXXX XXXXX" _
    " X   X   X   X         X     X     X X   X     X X   X     X" _
    " XXXXX XXXXX XXXXX XXXXX     X XXXXX XXXXX     X XXXXX     X"

    fnt = ImageCreate( 6 * 10, 6 )
    dim p as byte ptr = cast( byte ptr, fnt + 1 )
    p[0] = 0
    p[1] = asc("0")
    p[2] = asc("9")
    for i as integer = 0 to 9
        p[i+3] = 6
    next
    for y as integer = 1 to 5
        for x as integer = 0 to 10 * 6 - 1
            if( fontdata[ (y-1)*10 * 6 + x] = asc("X") ) then
                pset fnt,( x, y ), RGB( 255, 255, 255 )
            else
                pset fnt,( x, y ), RGB( 255, 0, 255 )
            end if
        next
    next

    function = fnt

end function

''
sub DrawCell( byval x as integer, byval y as integer )

    dim xx as integer = x * CELL_SIZE_W
    dim yy as integer = y * CELL_SiZE_H
    dim n as integer = CELLINDEX(x,y)

    if( Map(n).IsSolid ) then
        line( xx, yy ) - ( xx + CELL_SIZE_W - 1, yy + CELL_SIZE_H - 1 ), RGB(0,0,127), bf
    end if

    if( n = StartIndex ) then
        line( xx, yy ) - ( xx + CELL_SIZE_W - 1, yy + CELL_SIZE_H - 1 ), RGB(0,127,0), bf
    end if

    if( n = EndIndex ) then
        line( xx, yy ) - ( xx + CELL_SIZE_W - 1, yy + CELL_SIZE_H - 1 ), RGB(127,0,0), bf
    end if

    if( Map(n).state <> STATE_NONE ) then

        if( Map(n).state = STATE_OPEN ) then
            line( xx + 1, yy + 1 ) - ( xx + CELL_SIZE_W - 1 - 1, yy + CELL_SIZE_H - 1 - 1), RGB(0,255,0), b

        elseif( Map(n).state = STATE_CLOSED ) then
            line( xx + 1, yy + 1 ) - ( xx + CELL_SIZE_W - 1 - 1, yy + CELL_SIZE_H - 1 - 1), RGB(0,255,255), b
            line( xx + 2, yy + 2 ) - ( xx + CELL_SIZE_W - 1 - 2, yy + CELL_SIZE_H - 1 - 2), RGB(0,255,255), b
            line( xx + 3, yy + 3 ) - ( xx + CELL_SIZE_W - 1 - 3, yy + CELL_SIZE_H - 1 - 3), RGB(0,255,255), b

        end if

        if( Map(n).parent ) then
            dim x1 as integer = xx + CELL_SIZE_W \ 2
            dim y1 as integer = yy + CELL_SIZE_H \ 2
            dim dx as integer = ( Map(n).parent->x * CELL_SIZE_W + CELL_SIZE_W \ 2 - x1 )
            dim dy as integer = ( Map(n).parent->y * CELL_SIZE_H + CELL_SIZE_H \ 2 - y1 )
            dim nn as integer = sqr( dx * dx + dy * dy )
            dim mm as integer = CELL_SIZE_W \ 3
            circle( x1, y1 ), 3, RGB( 191, 191, 191 )
            line( x1, y1 ) - ( x1 + dx * mm \ nn, y1 + dy * mm \ nn ), RGB( 191, 191, 191 )

        end if

        draw string ( xx + 5, yy + 5 ), str( Map(n).f ), , fnt
        draw string ( xx + 5, yy + CELL_SIZE_H - 6 - 5), str( Map(n).g ), , fnt
        draw string ( xx + CELL_SIZE_W - 5 - len( str( Map(n).h )) * 6, yy + CELL_SIZE_H - 6 - 5), str( Map(n).h ), , fnt

    end if

    line( xx, yy ) - ( xx + CELL_SIZE_W - 1, yy + CELL_SIZE_H - 1 ), RGB(31,31,63), b

end sub

''
sub DrawMap()

    for y as integer = 0 to CELL_H - 1
        for x as integer = 0 to CELL_W - 1
            DrawCell x, y
        next
    next

end sub

''
sub DrawPath()

    dim c as CELL ptr = EndCell

    while( c->parent )

        dim x1 as integer = c->x * CELL_SIZE_W + CELL_SIZE_W \ 2
        dim y1 as integer = c->y * CELL_SIZE_H + CELL_SIZE_H \ 2
        circle( x1, y1 ), 9, RGB( 191, 0, 0 ),,,,f

        c = c->parent

    wend

end sub

'' ------------------------------------------------------------------
'' A* Computations
'' ------------------------------------------------------------------

''
function ASTAR_GetLowestF( ) as CELL ptr
    
    dim c as CELL ptr = NULL

    for i as integer = 0 to CELL_COUNT - 1

        if( Map( i ).State = STATE_OPEN ) then
            if( c = NULL ) then
                c = @Map(i)
            else
                if( Map(i).f < c->f ) then
                    c = @Map(i)
                end if
            end if
        end if

    next

    function = c
    
end function

''
function ASTAR_CheckNeighbour( byval parent as CELL ptr, byval x as integer, byval y as integer, cost as integer ) as integer

    function = FALSE

    if( x < 0 or x >= CELL_W ) then
        exit function
    end if

    if( y < 0 or y >= CELL_H ) then
        exit function
    end if

    dim c as CELL ptr = @Map( CELLINDEX(x, y) )

    if( c->IsSolid ) then
        exit function
    end if

    if( c->state = STATE_OPEN ) then
        if( parent->g + cost < c->g ) then
            c->state = STATE_NONE
        end if
    
    elseif( c->state = STATE_CLOSED ) then
        if( parent->g + cost < c->g ) then
            c->state = STATE_NONE
        end if
    end if

    if( c->state = STATE_NONE ) then
        c->state = STATE_OPEN
        c->g = parent->g + cost

        '' This is the Manhattan Distance Heuristic
        c->h = abs( c->x - EndCell->x ) * 10 + abs( c->y - EndCell->y ) * 10
        c->f = c->g + c->h
        c->parent = parent

    end if

    function = TRUE

end function

''
function ASTAR_CheckNeighbours(byval parent as CELL Ptr, _
                               byval x as integer, byval y as integer ) as integer
    
    const DIR_N = 1
    const DIR_S = 2
    const DIR_W = 4
    const DIR_E = 8

    dim flag as integer

    '' Check all orthogonal directions first N S E W
    if( ASTAR_CheckNeighbour( parent, x - 1, y    , 10 ) ) then
        flag or= DIR_W
    end if
    if( ASTAR_CheckNeighbour( parent, x    , y - 1, 10 ) ) then
        flag or= DIR_N
    end if
    if( ASTAR_CheckNeighbour( parent, x    , y + 1, 10 ) ) then
        flag or= DIR_S
    end if
    if( ASTAR_CheckNeighbour( parent, x + 1, y    , 10 ) ) then
        flag or= DIR_E
    end if

    '' Only allow a diagonal movement if both orthogonal
    '' directions are also allowed 
    if( ( flag and ( DIR_N or DIR_W )) = ( DIR_N or DIR_W ) ) then
        ASTAR_CheckNeighbour( parent, x - 1, y - 1, 14 )
    end if
    if( ( flag and ( DIR_S or DIR_W )) = ( DIR_S or DIR_W ) ) then
        ASTAR_CheckNeighbour( parent, x - 1, y + 1, 14 )
    end if
    if( ( flag and ( DIR_N or DIR_E )) = ( DIR_N or DIR_E ) ) then
        ASTAR_CheckNeighbour( parent, x + 1, y - 1, 14 )
    end if
    if( ( flag and ( DIR_S or DIR_E )) = ( DIR_S or DIR_E ) ) then
        ASTAR_CheckNeighbour( parent, x + 1, y + 1, 14 )
    end if

    function = 0

end function

''
sub ASTAR_Compute()

    dim c as CELL ptr

    '' Clear the A* calculations
    for i as integer = 0 to CELL_COUNT - 1
        Map(i).parent = NULL
        Map(i).state = STATE_NONE
        Map(i).f = 0
        Map(i).g = 0
        Map(i).h = 0
    next

    '' Set the starting CELL as the only one in the open set
    c = StartCell
    c->State = STATE_OPEN

    do

        c = ASTAR_GetLowestF()

        if( c = NULL ) then
            '' No OPEN cells, just quit
            exit do
        elseif( c = EndCell ) then
            '' Success
            exit do
        end if

        '' Add the current cell to the closed list
        c->state = STATE_CLOSED
        
        '' Add and compute neighbours
        ASTAR_CheckNeighbours( c, c->x, c->y )

    loop


end sub

'' ------------------------------------------------------------------
'' MAIN
'' ------------------------------------------------------------------

dim page as integer = 0
dim as integer mx,my,mz,mb,oldmb,xx,yy


CellClearAll()

'' Initialize the starting conditions
CellSetSolid( 5, 2, TRUE )
CellSetSolid( 5, 3, TRUE )
CellSetSolid( 5, 4, TRUE )

CellSetStart( 3, 3 )
CellSetEnd( 7, 3 )

screenres SCREEN_W, SCREEN_H, 32, 2

screenset page, 1-page
page = 1-page

fnt = CreateNumberFont()

do

    '' Check for input
    oldmb = mb
    GetMouse mx,my,mz,mb

    if( mx >= 0 and my >= 0 ) then
        xx = mx \ CELL_SIZE_W
        yy = my \ CELL_SIZE_H
        xx = iif( xx < 0, 0, iif( xx >= CELL_W, CELL_W - 1, xx ))
        yy = iif( yy < 0, 0, iif( yy >= CELL_H, CELL_H - 1, yy ))

        if( ( mb and 1 ) <> 0 and ( oldmb and 1 ) = 0 ) then
            CellSetStart( xx, yy )
        end if

        if( ( mb and 2 ) <> 0 and ( oldmb and 2 ) = 0 ) then
            CellSetEnd( xx, yy )
        end if

        if( ( mb and 4 ) <> 0 and ( oldmb and 4 ) = 0 ) then
            CellToggleSolid( xx, yy )
        end if
  end if

  if( multikey( fb.sc_escape ) ) then
    exit do
  end if

  '' Do the A* computation
  ASTAR_Compute()

  '' Render the output
  cls
  DrawMap()
  DrawPath()
  screenset page, 1-page
  page = 1-page
  sleep 50,1
loop

ImageDestroy(fnt)
j_milton
Posts: 458
Joined: Feb 11, 2010 17:35

Post by j_milton »

Your test program seems to generate grids with mostly 5 but sometimes 4 impassible squares, will this always be the case?

I assume that a valid route cannot pass through the same square more than one time, is this correct?
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

Thanks Joshy, but as I said, I need to find all paths, not just shortest path.

@j_milton
Number of impassible squares is irrelevant. It can vary from 0 to 36 (6*6). I was just using quick random placement with max 5 squares, just to show that they need to be taken into account.

Yes - same route cannot pass through same sqaure more than once, because in that case you'd have infinite routes.

Also, just to be clear - I've forgotten to mention that movement is 4-way, and not 8-way.
j_milton
Posts: 458
Joined: Feb 11, 2010 17:35

Post by j_milton »

nothing short of brute force occurs to me off the top of my head, sorry
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Post by agamemnus »

Breadth-first search would do it.

"All possible paths" however, could be quite a lot of paths... basically it would be, in its simplest form, all squares that connect with the target square eventually. Perhaps re-consider whether you really need "all possible paths". Maybe you actually just need to know all the squares that connect to your target? For that, you just need to do a "painting" or "filling" algorithm.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

Anyone at least having idea how to implement brute force?
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

i don't see the problem

you say it's a 4 way only move

if you mean no diagonal you can remove it from A path algo

then there are only 4 path's posible from A to B right ?

1) get the first (shortest path)
mark all cells on this path as non walkable

2) get the next path (if any)
mark all cells on this new path as non walkable

3) get the next path (if any)
mark all cells on this new path as non walkable

4) get the next path (if any)

what are the problem ?

Joshy
Image
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Post by rolliebollocks »

You can also add false obstructions to the shortest path algo until you've filled the grid...
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

It seems that I didn't define the problem very well. You can't use the same cell if you're searching for current path (for example red path), but you can use the same cell if you're searching for alternative path.

Image
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

if you can use a FREE cell more than once and directions are the number of posible direction from starting point 0-4 in this case
than the posible paths are near

paths = freecells^freecels*directions

there are 1000 ways go to Rome :lol:

what is it for a game ?

Joshy
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Post by agamemnus »

What you described will give you millions of solutions for even a moderately filled 20x20 grid.
Maybe try calling breadth-first search repeatedly, and fill traversed points for each path you find until you run out of solutions.
j_milton
Posts: 458
Joined: Feb 11, 2010 17:35

Post by j_milton »

duke4e wrote:Anyone at least having idea how to implement brute force?
some things we know about the problem:

let dns = the north-south distance between a and b
let dwe = the east-west distance between a and b
let min = dns + dwe
then the shortest possible path between a & b will be at least min moves long.

let i be the number of squares in the grid that are marked impassable at the begining of the problem.
let max = 35 - i
then the longest path between a & b cannot be more than max moves long

let the character set n,s,w,e, stand for moves to the north, south east and west from the current position.

then a starting set of possible solutions for brute force test, many of which would be illegal, would be the set of all possible strings using the characters nswe that are at least min characters long but not more than max characters long.

write a routine to generate all of them, (basically a min to max digit long base 4 counting routine) discard the invalid ones

obviously invalid:
- any with a substring of the same letter repeated more than 5 times consecutively
- any where (count n) - (count s) <> dns
- any where (count w) - (count e) <> dwe

step through the rest one move at a time, add to "bad list" discard if move goes off grid, onto an impassible square, onto a previously visited square.

add to good list if move goes onto square b (found one)

then we can also say that any new possible sequence that has a member of the bad list as a prefix is also bad

and we can also say that any new possible sequence that has a member of the good list as a prefix is also bad because it is longer than it legally can be

That's all that occurs to me for now.
Last edited by j_milton on Oct 17, 2010 4:50, edited 2 times in total.
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Post by counting_pine »

Perhaps you're looking for code that does the following?
1. Find shortest path
2. Mark all points on path (except start and end) as obstructed
3. If more paths goto 1

Yeah, for that you need something like A*, then just mark the path as useless.
This code is a bit of a mess, but illustrates what I mean:

Code: Select all

#include "fbgfx.bi"
Using FB

Const As Integer gridSize = 50
Const As Integer gridSizeHalf = gridSize / 2
Const As Integer gridX = 6
Const As Integer gridY = 6
Const As Integer xres = gridSize * gridX
Const As Integer yres = gridSize * gridY
Const As Integer midx = xres / 2
Const As Integer midy = yres / 2
Const As Single Pi = Atn(1) * 4
Const As Single TwoPi = Atn(1) * 8
Const As Single RAD = Pi / 180
Const As Single DEG = 180 / Pi

Dim Shared As Integer valueGrid(gridX, gridY)
Dim Shared As Integer x1, y1, x2, y2

Function randINT(first As Integer, last As Integer) As Integer
    Function = int(Rnd * (last - first) + first) '' Cint can round up!!!
End Function

Sub CenterText(text As String, xx As Integer, yy As Integer)
    Dim As Integer xOff = Len(text) * 4
    Draw String ((xx - xOff) + 2, yy - 3), text, Rgb(0, 0, 0)
End Sub

Sub InitGrid()
    For x As Integer = 0 To gridX - 1
        For y As Integer = 0 To gridY - 1
            valueGrid(x, y) = 1
        Next
    Next
   
    For i As Integer = 1 To 5
        valueGrid(randINT(0, gridX - 1), randINT(0, gridY - 1)) = 0
    Next
   
    Do
        x1 = randINT(0, gridX - 1)
        y1 = randINT(0, gridY - 1)
        x2 = randINT(0, gridX - 1)
        y2 = randINT(0, gridY - 1)
    Loop Until ((x1 <> x2) Or (y1 <> y2)) And valueGrid(x1, y1) = 1 And valueGrid(x2, y2) = 1
End Sub

Sub RenderGrid()
    Dim As Integer xx, yy
    For x As Integer = 0 To gridX - 1
        xx = x * gridSize
        For y As Integer = 0 To gridY - 1
            yy = y * gridSize
            If valueGrid(x, y) = 1 Then Line(xx, yy)-(xx + gridSize, yy + gridSize), Rgb(255, 255, 255), bf
            Line(xx, yy)-(xx + gridSize, yy + gridSize), Rgb(200, 200, 200), b
        Next
    Next
    CenterText("A", x1 * gridSize + gridSizeHalf, y1 * gridSize + gridSizeHalf)
    CenterText("B", x2 * gridSize + gridSizeHalf, y2 * gridSize + gridSizeHalf)
End Sub

function findshortestpath() as integer
    dim s as string '' stack
    dim as integer h(0 to gridX-1,0 to gridY-1)  '' had
    dim as integer fx(0 to gridX-1,0 to gridY-1) '' fromx
    dim as integer fy(0 to gridX-1,0 to gridY-1) '' fromy
    #macro rpush(x,y,x0,y0)
        if   (0 <= (x) and (x) < gridX) _
         and (0 <= (y) and (y) < gridY) _
         and (h(x,y) = 0) _
         and (valueGrid(x,y) = 1) then
            s &= chr(x,y)
            h(x,y) = 1
            fx(x,y) = x0
            fy(x,y) = y0
        end if
    #endmacro
    #macro lpop(x,y)
        x = asc(s, 1)
        y = asc(s, 2)
        s = mid(s, 3)
    #endmacro
    
    dim as integer x = x1, y = y1
    rpush(x, y, -1,-1)
    do
        if len(s) = 0 then return 0
        lpop(x,y)
        if (x = x2 and y = y2) then exit do
        rpush(x-1,y, x,y)
        rpush(x+1,y, x,y)
        rpush(x,y-1, x,y)
        rpush(x,y+1, x,y)
    loop
    
    dim as integer c = int(rnd*728):c = rgb(255*sin(c/99)^2,255*sin((c+241)/99)^2,255*sin((c+482)/99)^2)
    do until x = x1 and y = y1
        dim as integer x_ = x, y_ = y
        valueGrid(x_,y_) = 2
        'print using "(&,&)-(&,&)"; x_;y_; x;y
        x = fx(x_, y_): y = fy(x_, y_)
        line(x*gridSize+gridSizehalf,y*gridSize+gridSizehalf)-(x_*gridSize+gridSizehalf,y_*gridSize+gridSizehalf), c
    loop
    valueGrid(x1,y1) = 1
    valueGrid(x2,y2) = 1
    if abs(x2-x1)+abs(y2-y1) < 2 then return 0 '' points adjacent
    return 1
    
end function

Screenres xres, yres, 32
Color Rgb(255, 255, 255), Rgb(100, 100, 100)
Do
    static s as integer: s+=1: Randomize s
    InitGrid()
    Screenlock
    Cls
    RenderGrid()
    do: loop while findshortestpath()
    Screenunlock
    sleep
Loop until asc(inkey)=255
j_milton
Posts: 458
Joined: Feb 11, 2010 17:35

Post by j_milton »

counting_pine wrote:Perhaps you're looking for code that does the following?
1. Find shortest path
2. Mark all points on path (except start and end) as obstructed
3. If more paths goto 1
That won't find all paths in all cases
Many cases where a longer path will have square(s) in common with a shorter one
Post Reply