Print Page - A* pathfinding in QB64

Does anybody know of someone trying to implement an A* Pathfinding routine in QB64. the examples I've found are in other languages and trying to convert it to QB64 just isn't happening for me. I think I understand it but for some reason my mind just wont convert it to basic code. its probably easier than I think it should be and thats why but its just not happening for me yet.

HiCobalt,

I remember a discussion not long ago:
https://www.qb64.org/forum/index.php?topic=321.0

There is a method for Windows of creating a temp file in a shell of a directory listing from which you can get files and/or folders from which you access from QB64 for purposes of getting file(s) or subFolder lists. It is also possible to build a navigator from that. There is a fine example in Wiki from which I created a file retriever.

Wrong pathfinding bplus.
I mean from Point A to Point B on a map going around obstructions.

Perhaps from Javascript and with a good tutor you can convert it easier:

Would a map be a listing of which point connects to which point?

And a path be a string of points from a to b?

And do you want the shortest path or any old path that gets you there?

bplus: https://en.wikipedia.org/wiki/A*_search_algorithm (https://en.wikipedia.org/wiki/A*_search_algorithm)

Thanks I found this

Maybe it help.... works not full correctly... press key for move. It is different solution. I use many IF conditions...

Code: QB64: [Select]

 
'maze demo - quad go from sector A to sector B and respect walls:
 
DIM maze(99, 99) AS _BYTE
FOR Wall = 1 TO 1000
    begin:
    x = RND * 99
    y = RND * 99
    IF x > 99 OR y > 99 THEN GOTO begin
    IF maze(x, y) = 0 THEN maze(x, y) = 1 ELSE GOTO begin
NEXT Wall
 
'let say, start position for point is 1,1, end position is 100,100
maze(1, 1) = 2: x = 0: y = 0
SCREEN _NEWIMAGE(1000, 1000, 256)
 
FOR x = 0 TO 99
    FOR y = 0 TO 99
 
        IF maze(x, y) = 2 THEN clr = 15
        IF maze(x, y) = 1 THEN clr = 9
        IF maze(x, y) = 0 THEN clr = 0
        LINE (x * 10, y * 10)-((x * 10) - 9, (y * 10) - 9), clr, B 'show map
NEXT y, x
mX = 1
mY = 1
 
DO WHILE INKEY$ <> CHR$(27)
    s:
 
    IF posX + mX > 98 OR posX + mX < 1 THEN mX = -1 * mX
    IF posY + mY > 98 OR posY + mY < 1 THEN mY = -1 * mY
 
 
    oldX = posX
    oldY = posY
 
    oldmx = mX
    oldmy = mY
 
 
    IF maze(posX + mX, posY + mY) <> 1 THEN
        posX = posX + mX
        posY = posY + mY
    END IF
 
    LINE (posX * 10, posY * 10)-((posX * 10) - 9, (posY * 10) - 9), 15, B 'show map
    LINE (oldX * 10, oldY * 10)-((oldX * 10) - 9, (oldY * 10) - 9), 0, B 'show map
 
 
 
 
 
 
 
    IF posX + mX > 0 AND posX + mX < 99 AND posY + mY > 0 AND posY + mY < 99 THEN
 
        t = RND * 10
        IF t > .55 THEN
 
            IF posY > 0 AND posY < 98 THEN
                IF oldmx = mX AND maze(posX, posY - 1) <> 1 THEN mY = -1
                IF oldmx = mX AND maze(posX, posY + 1) <> 1 THEN mY = 1
            END IF
 
            IF posX > 0 AND posX < 98 THEN
                IF oldmy = mY AND maze(posX - 1, posY) <> 1 THEN mX = -1
                IF oldmy = mY AND maze(posX + 1, posY) <> 1 THEN mX = 1
            END IF
 
        END IF
 
 
 
        IF maze(posX, posY - 1) <> 1 AND mY = 0 THEN mY = -1
        IF maze(posX, posY + 1) <> 1 AND mY = 0 THEN mY = 1
        IF maze(posX - 1, posY) <> 1 AND mX = 0 THEN mX = -1
        IF maze(posX + 1, posY) <> 1 AND mX = 0 THEN mX = 1
 
 
        IF maze(posX + mX, posY + mY) = 1 THEN
            BEEP
            IF maze(posX + 1, posY) <> 1 THEN mX = 1: mY = 0: GOTO s
            IF maze(posX, posY + 1) <> 1 THEN mX = 0: mY = 1: GOTO s
            IF maze(posX - 1, posY) <> 1 THEN mX = -1: mY = 0: GOTO s
            IF maze(posX, posY - 1) <> 1 THEN mX = 0: mY = -1: GOTO s
        END IF
 
    END IF
    SLEEP
LOOP
 
 

But if you meant way, how to draw lines between two points (as LINE, but step by step with PSET), so i have writed program for it, he works correctly now in all directions,

Fellippe, thank you for link. This way can be used for new PAINT program - not limited to 1 border color.

Thanks guys. I think I'm finally getting my head wrapped round this.
And somehow I managed to find this bit of code actually written in QB64.

by u/ybycomh around 4 years ago.

Code: QB64: [Select]

REM $dynamic
 
TYPE Coord: x AS INTEGER: y AS INTEGER: END TYPE
 
TYPE PathCoord
    pos AS Coord ' Coordinates of position on map
    parent AS Coord ' Coordinates of previous position on path
    g AS INTEGER ' G cost value
    h AS INTEGER ' H cost value
    f AS INTEGER ' F = G + H (total movement cost)
    status AS INTEGER ' 0 for unsearched, 1 for open, 2 for closed (explored)
END TYPE
 
DIM SHARED TargetFound
DIM Start AS Coord, Target AS Coord
 
CONST RandomSearch = 1 ' 1 => Randomly decide intesnity of search estimations (rush)
CONST DEBUG = 50 ' 0 => Debug mode off
'''''''''''''''''' DEBUG > 0 => Debug mode on, where DEBUG is animation speed
'''''''''''''''''' -1 => Debug mode on with SLEEPs between frames
CONST Resx = 1024 ' Set Screen Resolution
CONST Resy = 768 ' If you change it, the map will automatically fill the screen
CONST FPS = 20 ' Animation Speed
CONST TileSize = 10 ' Set size of square tiles
CONST MinMapDensity = 10 ' Set range of density to fill generated maps with walls
CONST MaxMapDensity = 35
CONST MinWallLength = MinMapDensity / 2
CONST MaxWallLength = MaxMapDensity / 2
 
Mapx = INT((Resx * .95) / TileSize) ' Dimension SampleMap to fit to screen
Mapy = INT((Resy * .95) / TileSize)
DIM SampleMap(Mapx, Mapy)
 
MaxPathLength = Mapx * Mapy * 0.5 ' Max number of saved path positions
DIM Path(MaxPathLength) AS Coord '' Dimension array of path coords to be filled in later
 
CLS: SCREEN _NEWIMAGE(Resx, Resy, 256)
 
RANDOMIZE TIMER / 3
DO
    REDIM Path(MaxPathLength) AS Coord, SampleMap(Mapx, Mapy)
 
    FOR ix = 0 TO Mapx
        SampleMap(ix, 0) = 1: SampleMap(ix, Mapy) = 1
    NEXT
    FOR iy = 0 TO Mapy
        SampleMap(0, iy) = 1: SampleMap(Mapx, iy) = 1
    NEXT
 
    MapDensity = INT((MaxMapDensity - MinMapDensity) * RND) + MinMapDensity
    FOR ix = 0 TO Mapx
        FOR iy = 0 TO Mapy
            RandNumber = INT(100 * RND) + 1
            IF RandNumber < MapDensity THEN SampleMap(ix, iy) = 1
        NEXT
    NEXT
 
    FOR i = 0 TO (MapDensity * 2)
        WallDirection = INT(2 * RND) + 1
        WallLength = INT((MaxWallLength - MinWallLength) * RND) + MinWallLength
 
        IF WallDirection = 1 THEN
            WallX = INT((Mapx) * RND)
            IF WallX + WallLength > Mapx THEN WallX = Mapx - WallLength
            iy = INT(Mapy * RND)
            FOR ix = WallX TO (WallX + WallLength)
                SampleMap(ix, iy) = 1
            NEXT
        END IF
 
        IF WallDirection = 2 THEN
            WallY = INT((Mapy) * RND)
            IF WallY + WallLength > Mapy THEN WallY = Mapy - WallLength
            ix = INT(Mapx * RND)
            FOR iy = WallY TO (WallY + WallLength)
                SampleMap(ix, iy) = 1
            NEXT
        END IF
    NEXT
 
    DO
        Start.x = INT((Mapx - 2) * RND) + 2 ' Set start position
        Start.y = INT((Mapy - 2) * RND) + 2
        IF Collision(Start, SampleMap()) = 0 THEN EXIT DO
    LOOP
    DO
        Target.x = INT((Mapx - 2) * RND) + 2 ' Set target position
        Target.y = INT((Mapy - 2) * RND) + 2
        IF Collision(Target, SampleMap()) = 0 THEN EXIT DO
    LOOP
 
    CALL SetPath(Path(), Start, Target, SampleMap())
 
    i = 0
    DO: _LIMIT FPS: CLS
 
        FOR ix = 0 TO Mapx
            FOR iy = 0 TO Mapy
                IF SampleMap(ix, iy) = 1 THEN CALL DrawBlock(ix, iy, 15)
            NEXT
        NEXT
 
        COLOR 4
        IF TargetFound = 0 THEN LOCATE 5, 5: PRINT "TARGET CANNOT BE REACHED": _DISPLAY: _DELAY 2: EXIT DO
 
        i = i + 1
        CALL DrawBlock(Path(i).x, Path(i).y, 10)
        CALL DrawBlock(Target.x, Target.y, 4)
 
        IF Path(i).x = Target.x AND Path(i).y = Target.y THEN EXIT DO
        IF i = MaxPathLength THEN EXIT DO
        IF INKEY$ = CHR$(27) THEN END
        _DISPLAY
    LOOP
    i = 0
    ERASE Path
    ERASE SampleMap
    TargetFound = 0
    IF INKEY$ = CHR$(27) THEN END
LOOP
 
SUB SetPath (Path() AS Coord, StartPos AS Coord, TargetPos AS Coord, Map())
 
MaxPathLength = UBOUND(path)
Mapx = UBOUND(Map, 1)
Mapy = UBOUND(Map, 2)
 
DIM PathMap(Mapx, Mapy) AS PathCoord
 
FOR ix = 0 TO Mapx
    FOR iy = 0 TO Mapy
        PathMap(ix, iy).pos.x = ix
        PathMap(ix, iy).pos.y = iy
    NEXT
NEXT
 
DIM Cpos AS Coord: Cpos = StartPos
DIM SearchPathSet(4) AS PathCoord, OpenPathSet(MaxPathLength) AS PathCoord
 
DO
 
    PathMap(Cpos.x, Cpos.y).status = 2
    count = count + 1
 
    IF PathMap(TargetPos.x, TargetPos.y).status = 2 THEN TargetFound = 1: EXIT DO
    IF count > MaxPathLength THEN EXIT DO
 
    SearchPathSet(0) = PathMap(Cpos.x, Cpos.y)
    SearchPathSet(1) = PathMap(Cpos.x + 1, Cpos.y)
    SearchPathSet(2) = PathMap(Cpos.x - 1, Cpos.y)
    SearchPathSet(3) = PathMap(Cpos.x, Cpos.y + 1)
    SearchPathSet(4) = PathMap(Cpos.x, Cpos.y - 1)
 
    FOR i = 1 TO 4
        IF Collision(SearchPathSet(i).pos, Map()) <> 1 THEN
 
            IF SearchPathSet(i).status = 1 THEN
                NewG = PathGCost(SearchPathSet(0).g)
                IF NewG < SearchPathSet(i).g THEN SearchPathSet(i).g = NewG
            END IF
 
            IF SearchPathSet(i).status = 0 THEN
                SearchPathSet(i).parent = SearchPathSet(0).pos
                SearchPathSet(i).status = 1
                SearchPathSet(i).g = PathGCost(SearchPathSet(0).g)
                SearchPathSet(i).h = PathHCost(SearchPathSet(i), TargetPos)
                SearchPathSet(i).f = SearchPathSet(i).g + SearchPathSet(i).h
 
                OpenPathSet(OpenPathCount) = SearchPathSet(i)
                OpenPathCount = OpenPathCount + 1
            END IF
        END IF
    NEXT
 
    PathMap(Cpos.x + 1, Cpos.y) = SearchPathSet(1)
    PathMap(Cpos.x - 1, Cpos.y) = SearchPathSet(2)
    PathMap(Cpos.x, Cpos.y + 1) = SearchPathSet(3)
    PathMap(Cpos.x, Cpos.y - 1) = SearchPathSet(4)
 
    IF OpenPathCount > (MaxPathLength - 4) THEN EXIT DO
 
    LowF = 32000: ixOptimal = 0: iyOptimal = 0
    FOR i = 0 TO OpenPathCount
        IF OpenPathSet(i).status = 1 AND OpenPathSet(i).f <> 0 THEN
            IF OpenPathSet(i).f < LowF THEN
                LowF = OpenPathSet(i).f
                ixOptimal = OpenPathSet(i).pos.x
                iyOptimal = OpenPathSet(i).pos.y
                OptimalPath_i = i
            END IF
        END IF
    NEXT
 
    IF ixOptimal = 0 AND iyOptimal = 0 THEN EXIT DO
    Cpos = PathMap(ixOptimal, iyOptimal).pos
    OpenPathSet(OptimalPath_i).status = 2
 
    IF DEBUG <> 0 THEN
        CLS
        FOR ix = 0 TO Mapx
            FOR iy = 0 TO Mapy
                IF Map(ix, iy) = 1 THEN CALL DrawBlock(ix, iy, 15)
            NEXT
        NEXT
        CALL DrawBlock(TargetPos.x, TargetPos.y, 4)
        FOR ix = 0 TO Mapx
            FOR iy = 0 TO Mapy
                IF PathMap(ix, iy).status = 1 THEN CALL DrawBlock(ix, iy, 3)
                IF PathMap(ix, iy).status = 2 THEN CALL DrawBlock(ix, iy, 10)
            NEXT
        NEXT
        _DISPLAY
        IF INKEY$ = CHR$(27) THEN END
        IF DEBUG > 0 THEN _DELAY (.2 * (1 / DEBUG))
        IF DEBUG = -1 THEN SLEEP
    END IF
LOOP
 
IF TargetFound = 1 THEN
 
    DIM backpath(MaxPathLength) AS PathCoord
    backpath(0).pos = PathMap(TargetPos.x, TargetPos.y).pos
 
    FOR i = 1 TO count
        backpath(i).pos = PathMap(backpath(i - 1).pos.x, backpath(i - 1).pos.y).parent
        IF (startreached = 0) AND (backpath(i).pos.x = Start.Pos.x) AND (backpath(i).pos.y = Start.Pos.y) THEN
            pathlength = i: startreached = 1
        END IF
    NEXT
 
    i = 0: startreached = 0
    FOR iback = pathlength TO 0 STEP -1
        IF startreached = 1 THEN i = i + 1: Path(i) = backpath(iback).pos
        IF (startreached = 0) AND (backpath(iback).pos.x = Start.Pos.x) AND (backpath(iback).pos.y = Start.Pos.y) THEN
            Path(i) = backpath(iback).pos
            startreached = 1
        END IF
    NEXT iback
END IF
 
END SUB
 
FUNCTION PathGCost (ParentG)
PathGCost = ParentG + 10
END SUB
 
FUNCTION PathHCost (TilePath AS PathCoord, TargetPos AS Coord)
dx = ABS(TilePath.pos.x - TargetPos.x)
dy = ABS(TilePath.pos.y - TargetPos.y)
distance = SQR((TargetPos.x - TilePath.pos.x) ^ 2 + (TargetPos.y - TilePath.pos.y) ^ 2)
IF RandomSearch = 1 THEN SearchIntensity = INT(RND * 10)
PathHCost = ((SearchIntensity / 20) + 10) * (dx + dy + ((SearchIntensity / 10) * distance))
END FUNCTION
 
FUNCTION Collision (Position AS Coord, Map())
IF Map(Position.x, Position.y) <> 0 THEN c = 1
Collision = c
END FUNCTION
 
SUB DrawBlock (x, y, blockcolor)
x0 = ((x * TileSize) - (TileSize / 2)) + TileSize + 20
y0 = ((y * TileSize) - (TileSize / 2)) + TileSize
x1 = ((x * TileSize) + (TileSize / 2)) + TileSize + 20
y1 = ((y * TileSize) + (TileSize / 2)) + TileSize
LINE (x0, y0)-(x1, y1), blockcolor, BF
END SUB

That is pretty cool!

Alas, I have started to reinvent the wheel. Now I have something to compare my experiments with. Thanks!

So that's something! Thank you for sharing, I have what to study.

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Cobalt on August 11, 2018, 12:30:44 pm