Results 1 to 11 of 11

Thread: A* pathing algorithm

  1. #1
    Join Date
    Aug 2017
    Posts
    23
    Mentioned
    1 Post(s)
    Quoted
    4 Post(s)

    Default A* pathing algorithm

    If you don't know what A*/A-Star is(I didn't until about a week ago) it is used to find the best path between nodes by searching one at a time using a hierarchy to determine which nodes to search first.

    It works, but it is quite slow. I'm looking for tips on how to speed it up(coding wise), this is my first major endeavor with Pascal and Simba.

    in C:/Simba/map.bmp needs to be a 100x100 BMP with only black and white pixels.

    the output, which is saved every 10 seconds(so you can view progress), is C:/Simba/Pathedmap.bmp

    Currently a path of 120 tiles takes approximately 35 seconds to complete, and this is not set up to take diagonal pixels into account. However the code is there, it is commented out(my use for this does not allow diagonal movement).

    Also, the start and end locations have to be in a white tile, where the start and end locations ARE CONNECTED BY WHITE PIXELS. Or your computer might catch on fire or something.

    Also make sure map.bmp has at least a 1 pixel black outline.

    the output Pathedmap.bmp : yellow tiles are no longer able to be searched, pink-ish tiles are currently searchable, and the red line is the finished path.


    Change1: I have decreased the time from 30 seconds for a distance of 120, to around 250MS for a distance of 160. Changes to getlowestfscore.

    Change2: Time decreased from 31 MS for my map-(11,16) to (30,83)... LOTS of stuff changed.

    Simba Code:
    type

    node = record
      color : integer;
      fscore : integer;
      gscore : integer;
      hscore : integer;
      isopen : boolean;
      isclosed : boolean;
      x : integer;
      y : integer;
      parent : TPoint;
    end;

    nodelist = array of array of node;

    var
      map,mapx,mapy,x,y{,startx,starty,endx,endy},counter,starttime,savetime,endtime,pathx,pathy,ctime,itime,tcount,fcount,ftime,tftime,isopentime,isopentotal,isopencount : Integer;
      openedlist1,fscore,gscore,hscore : array of array of integer;
      closed,tocheck,path,finalpath : TPointArray;
      open : array of node;
      parent : array of array of TPoint;
      lowestf : TPoint;
      tiles : nodelist



    procedure printnode(i : node);
    begin
      write('color: ' +inttostr(i.color) + ', fscore: '+inttostr(i.fscore)+', gscore: '+inttostr(i.fscore)+', hscore: '+inttostr(i.hscore)+', closed: ');
      write(i.isclosed);
      write(', open ');
      write(i.isopen);
      writeln(', x: ' +inttostr(i.x)+ ', y: '+inttostr(i.y));
    end;

    function isOpen(x,y:integer) : boolean;
    begin
      result := tiles[x][y].isopen;
    end

    function isClosed(x,y:integer) : boolean;
    begin
      result := tiles[x][y].isclosed;
    end

    function getParentTile(x,y:integer) : TPoint;
    begin
      result := tiles[x][y].parent;
    end

    procedure addOpenList(j : node);
    var
    i : Integer;
    begin
        //printnode(j);
        i := length(open);
        setlength(open,i+1);
        open[i] := j;
    end

    function match(i,j:node) : boolean;
    begin
    result := (i.color = j.color) and (i.fscore = j.fscore) and (i.gscore = j.gscore)
        and (i.hscore = j.hscore) and (i.isopen = j.isopen) and (i.isclosed = j.isclosed)
          and (i.parent.x = j.parent.x) and (i.parent.y = j.parent.y) and (i.x = j.x)
            and (i.y = j.y);

    end

    procedure removeOpenList(t : node);
    var
      i,j : integer;
    begin

      for i := 0 to length(open) - 1 do
      begin
        if (match(open[i], t)) then
        begin
          for j := i to length(open) - 1 do
            open[j] := open[j+1];

        setlength(open,length(open) - 1);
        exit;
        end;
      end;
    end

    procedure addOpen(x,y:integer);
    begin
      fastsetpixel(map,x,y,13217535);
      tiles[x][y].isopen := true;
      addOpenList(tiles[x][y]);
    end

    procedure addClosed(x,y:integer);
    var
    i : Integer;
    begin
      fastsetpixel(map,x,y,62207);
      tiles[x][y].isclosed := true;
    end
    procedure removeOpen(x,y:integer);
    begin
      removeOpenList(tiles[x][y]);
      tiles[x][y].isopen := false;
    end

    procedure removeClosed(x,y:integer);
    begin
      tiles[x][y].isclosed := true;
    end

    {procedure printOpen();
    var
      i:integer;
    begin
      for i := 0 to length(open) do
        writeln(open[i]);
    end

    procedure printClosed();
    var
      i:integer;
    begin
      for i := 0 to length(Closed)-1 do
        writeln(Closed[i]);
    end}



    function Manhattan(x,y,x2,y2:Integer): Integer;
    begin
        result := (Abs(x-x2) + Abs(y-y2))*10;
    end;

    procedure opensurrounding(x,y,endx,endy:integer);
    var
      i : TPoint;
      j,g,myg : integer;

    begin
      myg := gscore[x][y];
      {writeln('mygstart' + inttostr(myg));
      setlength(tocheck,8);
      tocheck[0] := Point(x-1,y+1);
      tocheck[1] := Point(x,y+1);
      tocheck[2] := Point(x+1,y+1);
      tocheck[3] := Point(x-1,y);
      tocheck[4] := Point(x+1,y);
      tocheck[5] := Point(x-1,y-1);
      tocheck[6] := Point(x,y-1);
      tocheck[7] := Point(x+1,y-1);
      for j := 0 to length(tocheck) - 1 do
      begin
      if(j = 0) or (j = 2) or (j = 5) or (j = 7) then
      g := 14
      else
      g := 10;  }

      setlength(tocheck,4);
      tocheck[0] := Point(x,y+1);
      tocheck[1] := Point(x-1,y);
      tocheck[2] := Point(x+1,y);
      tocheck[3] := Point(x,y-1);
      g := 10;

      for j := 0 to length(tocheck) - 1 do
      begin
        if (tiles[tocheck[j].x][tocheck[j].y].color <> 0) then
        begin
        //writeln(isOpen(tocheck[j].x,tocheck[j].y));

        //writeln(isOpen(tocheck[j].x,tocheck[j].y));
        tiles[tocheck[j].x][tocheck[j].y].parent := Point(x,y);
        tiles[tocheck[j].x][tocheck[j].y].hscore := Manhattan(tocheck[j].x,tocheck[j].y,endx,endy);
        tiles[tocheck[j].x][tocheck[j].y].gscore := g + myg;
        tiles[tocheck[j].x][tocheck[j].y].fscore := (hscore[tocheck[j].x][tocheck[j].y] + g + myg);
        tiles[tocheck[j].x][tocheck[j].y].x := tocheck[j].x;
        tiles[tocheck[j].x][tocheck[j].y].y := tocheck[j].y;
        if not (isOpen(tocheck[j].x,tocheck[j].y)) then
          addopen(tocheck[j].x,tocheck[j].y);
        end;
      end;
    end;

    procedure opensurroundingignoreclosed(x,y,endx,endy:integer);
    var
    i : TPoint;
    j,g,myg : integer;

    begin
      myg := tiles[x][y].gscore;
      //writeln('mygclosed: ' + inttostr(myg));
      {setlength(tocheck,8);
      tocheck[0] := Point(x-1,y+1);
      tocheck[1] := Point(x,y+1);
      tocheck[2] := Point(x+1,y+1);
      tocheck[3] := Point(x-1,y);
      tocheck[4] := Point(x+1,y);
      tocheck[5] := Point(x-1,y-1);
      tocheck[6] := Point(x,y-1);
      tocheck[7] := Point(x+1,y-1);
      for j := 0 to length(tocheck) - 1 do
      begin
      if(j = 0) or (j = 2) or (j = 5) or (j = 7) then
      g := 14
      else
      g := 10;}

      setlength(tocheck,4);

      tocheck[0] := Point(x,y+1);
      tocheck[1] := Point(x-1,y);
      tocheck[2] := Point(x+1,y);
      tocheck[3] := Point(x,y-1);

      g := 10;
      for j := 0 to length(tocheck) - 1 do
      begin
        if (tocheck[j].x >= 0) and (tocheck[j].x < mapx) and (tocheck[j].y >= 0) and (tocheck[j].y <= mapy) then
        begin
        if (tiles[tocheck[j].x][tocheck[j].y].color <> 0) then
        begin
            if not (isOpen(tocheck[j].x,tocheck[j].y)) and not (isClosed(tocheck[j].x,tocheck[j].y)) then
            begin
              tiles[tocheck[j].x][tocheck[j].y].parent := Point(x,y);
              tiles[tocheck[j].x][tocheck[j].y].hscore := Manhattan(tocheck[j].x,tocheck[j].y,endx,endy);
              tiles[tocheck[j].x][tocheck[j].y].gscore := (g + myg);
              tiles[tocheck[j].x][tocheck[j].y].fscore := (tiles[tocheck[j].x][tocheck[j].y].hscore + (g + myg));
              tiles[tocheck[j].x][tocheck[j].y].x := tocheck[j].x;
              tiles[tocheck[j].x][tocheck[j].y].y := tocheck[j].y;
              addopen(tocheck[j].x,tocheck[j].y);
            end;
          end;
        end;
      end;
    end;

    function getLowestFScoreOpen():TPoint;
    var
    low,lx,ly,x,y,i:integer;
    tilething : TPoint;
    //n : node;
    begin
      low:=10000000;

      {//writeln(open[length(open)]);
      for i := (length(open) - 1) downto 0 do
      begin
        if(fscore[open[i].x][open[i].y] < low) and (fscore[open[i].x][open[i].y] >= 1) then
        begin
          lx := open[i].x;
          ly := open[i].y;
          low := fscore[open[i].x][open[i].y];
        end;
      end;
       }

      {
      for x := 0 to length(tiles) - 1 do
      begin
        for y := 0 to length(tiles[0]) -1 do
        begin
          if(tiles[x][y].isOpen) then
          begin

            if(tiles[x][y].fscore < low) then
            begin
            //writeln('found new low');
            lx := x;
            ly := y;
            low := tiles[x][y].fscore;
            end;
          end;
        end;

      end;
      }

      for i := length(open) -1 downto 0 do
      begin
        if(open[i].fscore < low) then
        begin
          lx := open[i].x;
          ly := open[i].y;
          low := open[i].fscore;
        end;
      end;
      if (low  < 10000000) then
      begin
        result := Point(lx,ly);
        exit;
      end;
      result := Point(-1,-1);
    end

    function getPath(startx,starty,endx,endy:integer) : TPointArray;
    var
      retpath : TPointarray;
    begin
      setlength(path,0);
      setlength(open,0);
      setlength(closed,0);
      map := LoadBitmap('C:/Simba/map.bmp');
      getBitmapSize(map,mapx,mapy);
      setlength(openedlist1,mapx,mapy);
      setlength(tiles,mapx,mapy);
      setlength(fscore,mapx,mapy);
      setlength(gscore,mapx,mapy);
      setlength(hscore,mapx,mapy);
      setlength(parent,mapx,mapy);
      dec(mapx);
      dec(mapy);
      for y:= 0 to mapy do
      begin
        for x := 0 to mapx do
        begin
          tiles[x][y].color := FastGetPixel(map,x,y);
          tiles[x][y].fscore := -1;
          tiles[x][y].hscore := -1;
          tiles[x][y].gscore := -1;
          tiles[x][y].isopen := false;
          tiles[x][y].isclosed := false;
          tiles[x][y].x = x;
          tiles[x][y].y = y;
          tiles[x][y].parent := point(-1,-1);
        end;
      end;

      starttime := GetSystemTime();
      savetime := starttime;
      tiles[startx][starty].parent := Point(startx,starty);
      tiles[startx][starty].hscore := Manhattan(startx,starty,endx,endy);
      tiles[startx][starty].gscore := 10;
      tiles[startx][starty].fscore := hscore[startx][starty] + 10;
      tiles[startx][starty].x := startx;
      tiles[startx][starty].y := starty;
      AddOpen(startx,starty);
      opensurrounding(startx,starty,endx,endy);
      RemoveOpen(startx,starty);
      AddClosed(startx,starty);


      for counter := 0 to (mapx*mapy) do
      begin
        if(isOpen(endx,endy)) or (isClosed(endx,endy)) then
        begin
          writeln('found end in ' +inttostr(GetSystemTime() - starttime) + ' MS');
          break;
        end;
        if((getSystemTime() - savetime) > 10000) then
        begin
          savebitmap(map,'C:\Simba\pathedmap.bmp');
          writeln('bitmap saved');
          savetime := getSystemTime();
        end;
        ftime := getSystemTime();
        lowestf := getLowestFScoreopen();
        //writeln(lowestf);
        tftime := ((getSystemTime() - ftime) + tftime);
        inc(fcount,1);
        if (lowestf.x >=0) then
        begin
              ctime := getSystemTime();
          x:=lowestf.X;
          y:=lowestf.Y;
          removeOpen(x,y);
          AddClosed(x,y);
          opensurroundingignoreclosed(x,y,endx,endy);
          itime := ((getSystemTime() - ctime) + itime);
          inc(tcount,1);
        end;
      end;
      lowestf := getParentTile(endx,endy);
      pathx := lowestf.X;
      pathy := lowestf.Y;

      //addPath(endx,endy);
      while not ((pathx = startx) and (pathy = starty)) do
      begin
        if(pathx = -1) then
        begin
          writeln('bad path');
          exit;
        end;
        lowestf := getParentTile(pathx,pathy);
        pathx := lowestf.X;
        pathy := lowestf.Y;
        fastsetpixel(map,pathx,pathy,2366701);
        //addPath(pathx,pathy);
      end;
            //writeln('ctime' + inttostr(getSystemTime() - ctime) +','+inttostr(tcount) +' totaltime: ' + inttostr(itime));
      writeln(inttostr(tcount) + ' open totaltime: ' +inttostr(itime));
      write('avg itime ');
      writeln((itime/tcount));
      writeln(inttostr(fcount) + ' lowfcount totaltime: ' +inttostr(tftime));
      write('avg ftime ');
      writeln((tftime/fcount));
      //isopentime,isopentotal,isopencount
      //writeln(inttostr(isopencount) + ' totalisopentime: ' +inttostr(isopentotal));
      //write('avg isopentime ');
      //writeln((isopentotal/isopencount));
      writeln('saving map');
      savebitmap(map,'C:\Simba\pathedmap.bmp');
      InvertTPA(path);
      result := path;
    end;

    begin
      finalpath := getPath(3,3,634,476);
      writeln('path length ' + inttostr(length(finalpath)));
      //currently if you run this more than one time(per script run), the script will mess up
      //due to painting on the map for debugging.
    end.
    The uploads are an example of the file to use as map.bmp(the first one), THESE ARE PNGS AS AN EXAMPLE. It would not let me upload the bitmaps.
    example2 is while it was in progress, example3 is the final output with the best path drawn.
    example1.png
    example2.jpg
    example3.png
    Last edited by JimmyJay; 09-06-2017 at 06:08 PM.

  2. #2
    Join Date
    May 2012
    Location
    Glorious Nippon
    Posts
    1,011
    Mentioned
    50 Post(s)
    Quoted
    505 Post(s)

    Default

    Quote Originally Posted by JimmyJay View Post
    op
    I used Dijkstra's algorithm to make a reflection walker once. I had roughly 2000 nodes, but it didn't take more than a second to generate the path.
    I've never written an implementation of A*, but it definitely shouldn't be so slow. Reading other peoples' code isn't my forte, so idk how much I'll be able to help.
    Why are you doing this?
    Simba Code:
    for counter := 0 to 5000000 do
    I see that you break when you're finished, but a while loop would fit better imo.
    Maybe you could debug by breaking it down and writing how long each step takes to find the slow part.
    Also, you need to free your bitmap(s).

  3. #3
    Join Date
    Aug 2017
    Posts
    23
    Mentioned
    1 Post(s)
    Quoted
    4 Post(s)

    Default

    Dijkstra's is just A* without the g cost, if you wanted to turn this into dijkstra's all you would have to do would make Manhattan return 0, and set g in open surrounding and opensurroundingignoreclosed to 0

    The counter is so it will eventually stop(ie the points are not connected) I suppose 100*100 would be a more appropriate value.

    I could do while not (isopen(endx,endy)), but it could never stop if the points aren't connected

    But A* should be faster than dijkstra's because if there are not multiple turns in the path, (u turns) then it will expand the search outwards less
    Last edited by JimmyJay; 09-05-2017 at 04:57 AM.

  4. #4
    Join Date
    Aug 2017
    Posts
    23
    Mentioned
    1 Post(s)
    Quoted
    4 Post(s)

    Default

    I cut it down from 30+ seconds for a 120 distance path to ~250MS for a 160 distance path.

  5. #5
    Join Date
    Feb 2012
    Location
    Norway
    Posts
    995
    Mentioned
    145 Post(s)
    Quoted
    596 Post(s)

    Default

    Should really find yourself a bigger maze to test on, since A-star wont have any realistic benefits on something that small versus any bruteforce solution like bfs/dfs.
    I wrote a VERY simple version of BFS which used 17ms to solve (11,16) to (30,83) for that small image, a more optimal varaint should be down to around 10ms.
    Simba Code:
    procedure DebugBitmap(bmp: Integer);
    var w,h: Int32;
    begin
      GetBitmapSize(bmp, w,h);
      DisplayDebugImgWindow(w,h);
      DrawBitmapDebugImg(bmp);
    end;

    procedure GetAdjacent(var adj:TPointArray; n:TPoint; EightWay:Boolean);
    begin
      adj[0] := Point(n.x-1,n.y);
      adj[1] := Point(n.x,n.y-1);
      adj[2] := Point(n.x+1,n.y);
      adj[3] := Point(n.x,n.y+1);
      if EightWay then
      begin
        adj[4] := Point(n.x-1,n.y-1);
        adj[5] := Point(n.x+1,n.y+1);
        adj[6] := Point(n.x-1,n.y+1);
        adj[7] := Point(n.x+1,n.y-1);
      end;
    end;

    function SolveMaze(Start, Stop: TPoint; Img: PtrInt): TPointArray;
    var
      w,h,i,x: Int32;
      queue: T2DPointArray;
      adj, path: TPointArray;
      pt: TPoint;
    begin
      GetBitmapSize(img, W,H); Dec(W); Dec(H);
      SetLength(adj, 8);
      queue += [start];
      while Length(queue) > 0 do
      begin
        path := queue[High(queue)];
        SetLength(queue, Length(queue)-1);
        pt := path[High(path)];
        if pt = stop then Exit(path);

        GetAdjacent(adj, pt, Length(adj)=8);
        for i:=0 to High(adj) do
          if InRange(adj[i].x, 0, w) and InRange(adj[i].y, 0, h) and
             (FastGetPixel(Img, adj[i].x,adj[i].y) = $FFFFFF) then
          begin
            FastSetPixel(Img, adj[i].x,adj[i].y, $666666);
            //if (x+=1) mod 500 = 0 then DebugBitmap(img);
            Insert(path + adj[i], queue, 0);
          end;
      end;
    end;

    Here is a larger maze, I believe decent a* implementation in Lape (Simba) should use between a few hundred ms up to a second at worst. This is where a* and similar will shine versus bruteforce algorithms. Keep in mind that the BFS above uses roughly 3 seconds.
    http://i.imgur.com/P2zfYJ4.png
    Last edited by slacky; 09-05-2017 at 07:06 PM.
    !No priv. messages please

  6. #6
    Join Date
    Nov 2011
    Location
    England
    Posts
    3,072
    Mentioned
    296 Post(s)
    Quoted
    1094 Post(s)

    Default

    Quote Originally Posted by slacky View Post
    Here is a larger maze, I believe decent a* implementation in Lape (Simba) should use between a few hundred ms up to a second at worst. This is where a* and similar will shine versus bruteforce algorithms. Keep in mind that the BFS above uses roughly 3 seconds.
    Is this decent enough? Took me ages to write https://pastebin.com/UXujWdGW - 600ms.
    Last edited by Olly; 09-05-2017 at 11:47 PM.

  7. #7
    Join Date
    Feb 2012
    Location
    Norway
    Posts
    995
    Mentioned
    145 Post(s)
    Quoted
    596 Post(s)

    Default

    Quote Originally Posted by Olly View Post
    Is this decent enough? Took me ages to write https://pastebin.com/UXujWdGW - 600ms.
    Nice find, I really didn't remember that I had that on my pastebin, tho from 2013 so no surprise I had forgotten about it

    Edit: For comparison, that A* implementation on my pastebin uses ~6ms to solve the original maze with the given coordinates (11,16), (30,83). So thread-starter can by all means get some ideas from it.
    Last edited by slacky; 09-06-2017 at 03:28 PM.
    !No priv. messages please

  8. #8
    Join Date
    Aug 2017
    Posts
    23
    Mentioned
    1 Post(s)
    Quoted
    4 Post(s)

    Default

    So I've now cut it down to 31 MS for my map-(11,16) to (30,83), but from the top left to the bottom right of your maze, its taking roughly 75 seconds

    More debugging I suppose.

    so, this is costing about 65 of the 75 seconds...

    Simba Code:
    procedure removeOpenList(t : node);
    var
      i,j : integer;
    begin

      for i := 0 to length(open) - 1 do
      begin
        if (match(open[i], t)) then
        begin
          for j := i to length(open) - 2 do
            begin
              open[j] := open[j+1];
              end;
        setlength(open,length(open) - 1);
        exit;
        end;
      end;
    end
    (this finds the node in an array of nodes, then shifts all of the others up 1 place when it finds it to remove it, while keeping them in order)

    how do I possibly speed this up? it is, however, being called 106,000(taking an average of 0.62MS) times on your maze.
    Last edited by JimmyJay; 09-06-2017 at 05:42 PM.

  9. #9
    Join Date
    Aug 2017
    Posts
    23
    Mentioned
    1 Post(s)
    Quoted
    4 Post(s)

    Default

    Are you getting similar results with your A*? Also script in OP is now what I am currently debugging

    pathedmap.png

  10. #10
    Join Date
    Feb 2012
    Location
    Norway
    Posts
    995
    Mentioned
    145 Post(s)
    Quoted
    596 Post(s)

    Default

    Quote Originally Posted by JimmyJay View Post
    Are you getting similar results with your A*? Also script in OP is now what I am currently debugging

    pathedmap.png
    When using squared Euclidean distance:
    result.png

    Edit: I get ALMOST the same result when using Manhattan distance like you are, and that did slow it down to use 1 second on my PC.
    Last edited by slacky; 09-07-2017 at 06:23 AM.
    !No priv. messages please

  11. #11
    Join Date
    Aug 2017
    Posts
    23
    Mentioned
    1 Post(s)
    Quoted
    4 Post(s)

    Default

    Interesting results... Manhattan works well with a G score of 10, I will have to play with the G score and see if I can find something that doesn't do weird things to my path.

    Thank you, this cut it down to 6 seconds

    (Euclidean instead of Manhattan)
    pathedmap.png

    edit: I did a little reading about gscore/hscore ratios... when I change the *10 in Manhattan to *20, I see results more like the ones your getting from Euclidean... Also way faster than I had before
    Last edited by JimmyJay; 09-06-2017 at 08:51 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •