SRL Archive - Research & Development Lounge

Path finder, much like my previous A* stuff, but without heuristic. I've tried to streamline it and speed it up as much as I can - there's still more and I can always try experimental stuff. This is mainly just for Ray though, so he can laugh at my bad coding skills :)

Excuse the slow bitmap loading, but I know how much people hate downloading bitmaps/having large bitmap strings to use with this stuffs and it should normally be fine, but atm pastebin seems to be a bit slow, so may take a bit :)

It is also somewhat badly commented, so if you do read it, then they should provide a little help for understanding my twisted logic.

program PathFinding;
type
  TNode = record
     tp: TPoint;
    prt: Integer;
    dis: Integer;
    s,a: Boolean;
  end;

function TPDist(a, b: TPoint): Integer;
begin
  Result := Trunc(Sqrt(Sqr(a.x - b.x) + Sqr(a.y - b.y)) * 10.0);
end;

function Dijkstra(st, en: TPoint; input: array of TPoint; inDis: Integer): array of TPoint;
var
  h, i, t, d: Integer;
  n: array of TNode;
  a, s: TIntegerArray; // (Available, Set, both) node indexes
  nh, ah, sh: Integer;
  lv, li: Integer; // lowest (value, index)

begin
  SetLength(Result, 0);

  h := Length(input) + 1;
  SetLength(input, h);
  input[h - 1] := st;
  
  SortTPAFrom(input, st); // *Should* improve performance by leaving sorted this way
  
  SetLength(n, h);
  SetLength(a, h);
  SetLength(s, h);
  h := h - 1;

  nh := 0;
  ah := -1;
  sh := 0;
  
  for i := 0 to h do
  begin
    n[i].tp := input[i];
    n[i].s := False;
    n[i].a := False;
  end;
  
  n[0].prt := -1;
  n[0].dis := 0;
  n[0].s := True;
  n[0].a := True;

  s[0] := 0;
  inDis := inDis * 10;
  lv := inDis + 10;
  li := 0;
  
  repeat
    { begin newly discovered node search }
    for i := 0 to h do
    begin
      if n[i].s then
        continue;

      d := TPDist(n[s[sh]].tp, n[i].tp);
      // Get distance from current node to last set node

      if d > inDis then // if it's not in range
      begin
        //Writeln(IntToStr(d) + '/' + IntToStr(inDis));
        continue; // go onto next point
      end;
        
      d := n[s[sh]].dis + d; // Get distance to point using current nodes path
        
      if n[i].a then // if point is already added
      begin
        if d > n[a[i]].dis then // If it's longer path
          d := n[a[i]].dis
        else // else if it's a shorter path
        begin
          n[a[i]].dis := d;
          n[a[i]].prt := s[sh];
        end;
        
        if d < lv then  // If it is the current, 'closet' unset node
        begin
          lv := d;  // Reassign lv and li
          
          for li := 0 to ah do // loop through to find out which a[] it links with
            if i = a[li] then // if it's the node
              break; // stop - li retains correct value
        end;
      end
      else // if unadded, setup a couple of things
      begin
        ah := ah + 1;
        a[ah] := i; // Add it onto the available node list
        n[i].a := True;
        n[i].prt := s[sh]; // and assign the node values
        n[i].dis := d;
        
        if d < lv then // If it is the current, 'closet' unset node
        begin
          lv := d; // Reassign lv and li to this node
          li := ah;
        end;
      end;
    end;
    { End of node searching }

    sh := sh + 1;
    //Writeln(IntToStr(li) + '/' + IntToStr(h));
    s[sh] := a[li]; // Add the 'closest' unset node to the set list
    n[a[li]].s := True; // Set the node to set
    Swap(a[li], a[ah]); // Switch it to the end
    ah := ah - 1;   // and remove it from the available list by cutting it off

    if ah = -1 then // if we have run out of open nodes
    begin
      Writeln('Unable to find path.');
      //exit; // then there is no path
      break;
    end;

    lv := n[a[0]].dis; // Set default lowest value and lowest index
    li := a[0];

    if TPDist(en, n[s[sh]].tp) <= inDis then
        break; // then stop searching
  until false;
  
  SetLength(Result, h + 3); // +1 due to high, +2 due to origin and destination point
  
  h := 0;
  Result[0] := en;
  i := s[sh];
  t := 1;
  repeat
    Result[t] := n[i].tp;
    t := t + 1;
    i := n[i].prt;
  until i = -1;
  Result[t] := st;
  h := t + 1;

  SetLength(Result, h);

  InvertTPA(Result);
end;

function ParsePastebinBitmap: string;
var
  s: string;
begin
  Result := '';
  Writeln('Getting page - may take a bit');
  s := GetPage('http://pastebin.com/f485ae5c0');
  Writeln('Got page! Now parsing');
  Delete(s, 1, PosEx('beNrsvV+MHfd156mZx', s, Pos('beNrsvV+MHfd156mZx', s) + 1) - 1);
  Delete(s, Pos('=', s) + 1, Length(s));
  s := Replace(s, #13 + #10, '');
  if s = '' then
  begin
    Writeln('Parsing failed, try again and double check pastebin link is valid');
    TerminateScript;
  end;
  Result := s;
end;

var
  b, t, w, h, c, i: Integer;
  pts, temp: TPointArray;
  ptar: array of TPointArray;
  beg, fin: TPoint;
  s: string;
begin
  Writeln('Begin');
  w := 745;
  h := 450;
  DisplayDebugImgWindow(w, h);
  t := GetSystemTime;
  try
    //b := LoadBitmap(AppPath + 'pics/benchmark.bmp');
    b := BitmapFromString(w, h, ParsePastebinBitmap);
  except
    Writeln('Loading epicly large bitmap failed :<');
    TerminateScript;
  end;
  t := GetSystemTime - t;
  Writeln('Bitmap loading took ' + IntToStr(t) + 'ms');
  SetTargetBitmap(b);
  GetDebugCanvas.Rectangle(0, 0, w, h);

  c := BitmapFromString(w, h, '');
  FastDrawTransparent(0, 0, b, c);

  beg := IntToPoint(110, 330);
  SafeCopyCanvas(GetBitmapCanvas(c), GetDebugCanvas, 0, 0, w, h, 0, 0, w, h);
  Writeln('About to perform search...');

  FindColorsTolerance(pts, GetColor(beg.x, beg.y), 0, 0, w, h, 5);
  SetLength(temp, 0);

  fin := pts[Random(Length(pts))];

  ptar := TPAtoATPA(pts, 2);
  SetLength(pts, Length(ptar));

  for t := 0 to High(ptar) do
  begin
    pts[t] := MiddleTPA(ptar[t]);
    FastSetPixel(c, pts[t].x, pts[t].y, clRed);
  end;

  GetBitmapCanvas(c).Brush.Color := clAqua;
  GetBitmapCanvas(c).Ellipse(beg.x - 3, beg.y - 3, beg.x + 3, beg.y + 3);
  GetBitmapCanvas(c).Ellipse(fin.x - 3, fin.y - 3, fin.x + 3, fin.y + 3);
  SafeCopyCanvas(GetBitmapCanvas(c), GetDebugCanvas, 0, 0, w, h, 0, 0, w, h);

  Writeln('Performing A* search now with ' + IntToStr(Length(pts)) + ' points as input...');
  t := GetSystemTime;

  SortTPAFrom(pts, beg);
  SetLength(pts, Length(pts) + 1);
  pts[High(pts)] := fin;
  AStarCus(temp, pts, 0, High(pts), 4, 4);
  if Length(temp) <> 0 then
  begin
    t := GetSystemTime - t;
    Writeln('Success! Path is ' + IntToStr(Length(temp)) + ' nodes long');
    GetBitmapCanvas(c).Pen.Color := clFuchsia;
    GetBitmapCanvas(c).MoveTo(temp[0].x, temp[0].y);
    for i := 0 to High(temp) do
    begin
      GetBitmapCanvas(c).LineTo(temp[i].x, temp[i].y);
    end;
    SafeCopyCanvas(GetBitmapCanvas(c), GetDebugCanvas, 0, 0, w, h, 0, 0, w, h);
  end
  else
  begin
    t := GetSystemTime - t;
    Writeln('Failed');
  end;

  Writeln('Took ' + IntToStr(t) + 'ms');

  Writeln('Performing Dijkstra search now with ' + IntToStr(Length(pts)) + ' points as input...');
  t := GetSystemTime;
  
  temp := Dijkstra(beg, fin, pts, 5);

  if Length(temp) <> 0 then
  begin
    t := GetSystemTime - t;
    Writeln('Success! Path is ' + IntToStr(Length(temp)) + ' nodes long');
    GetBitmapCanvas(c).Pen.Color := clLime;
    GetBitmapCanvas(c).MoveTo(temp[0].x, temp[0].y);
    for i := 0 to High(temp) do
    begin
      GetBitmapCanvas(c).LineTo(temp[i].x, temp[i].y);
    end;
    SafeCopyCanvas(GetBitmapCanvas(c), GetDebugCanvas, 0, 0, w, h, 0, 0, w, h);
  end
  else
  begin
    t := GetSystemTime - t;
    Writeln('Failed');
  end;
  Writeln('Took ' + IntToStr(t) + 'ms');


  FreeBitmap(b);
  FreeBitmap(c);
  Writeln('End');
end.

Note that it does also have my A* stuff in it, commented, and you can uncomment if you have the accompanying plugin to see the difference in the paths. Likewise, if you have the benchmarking bitmap I think I gave out, then you can use that rather than my silly pastebin parser.

Raymond something like this already before. It's in one of the programming forums. I think Delphi. But cool SCAR port.

I did see a somewhat Scar'y version he made somewhere, but it was from a long time back. I would also think that it wouldn't bare much similarity apart from the algorithm used to generate it - this is about the 5th version of the same algorithm I have produced, so it has *hopefully* been sped up a lot more compared to the base algorithm. Also, this is pretty much what I'm going to try and use as part of SPAM/S if I can get Smart working on a pc I have access to. I just need to ensure/work out the bugs and seeing if I can reliably speed it up without affecting accuracy first, then I can pluginise it :)

Ray made one I ordered from him to that u give start and end coords, and the TPA array of possible tiles (I posted somewhere a function finding the walkable tiles), and it shits out a TPA of the path :)

Bah, people keep saying it, but without the actual posts just saying is useless! I can't even compare the two if I don't have any versions of his :(

Haha failsors spotted

http://villavu.com/forum/showthread.php?t=36548

Bah, his is embedded into a form making it quite hard to easily compare the two. Maybe if he wanted to adapt it to a similar style to mine, TPA with distance based node discovery, we could compare with decent input :)

Good Job ;D.
For a working version you should reduce the amounts of points by about 95% though ;D. Or use a quicker algorithm ( http://en.wikipedia.org/wiki/A*_search_algorithm ).

Also it would be cool if you'd optically connect each node on the debug.

~caused

I could reduce input, but it compromises output. Also, I have made an implementation of the A*, but Ray and co always complained about it - the only advantage it has is a heuristic that keeps the algorithm looking in roughly the right direction.

Oh and the problem in linking up all nodes is that I'm not using real nodes. I could link them up like a real graph would, but as I mentioned above the large input is required for accurate output and so it would be nearly unreadable with this in place.

As a last little point, placing inside a plugin would speed it up to mere seconds at most, so the time isn't so much a problem until you start using even larger input :)