Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Общие вопросы по программированию, компьютерный форум
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.01.2012, 16:24   #1
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию Поиск пути (алгоритм А* / Дейкстра)

Пытался реализовать алгоритм A* (точнее пока алгоритм Дейкстры т.е. без эвристики) по этой статье: http://www.policyalmanac.org/games/a...torial_rus.htm

Получился вот такой код — http://ideone.com/OA9Q0, но работает неверно (находит неправильный путь). Что не так?Там, где пустой begin end; по идее должен был быть пункт

Цитата:
Если клетка уже в открытом списке, то проверяем, не дешевле ли будет путь через эту клетку. Для сравнения используем стоимость G. Более низкая стоимость G указывает на то, что путь будет дешевле. Если это так, то меняем родителя клетки на текущую клетку и пересчитываем для нее стоимости

но насколько я понял он вроде бы никак не должен влиять т.к. двигаться можно только в 4 стороны?
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.

Последний раз редактировалось Alex11223; 30.01.2012 в 16:33.
Alex11223 вне форума Ответить с цитированием
Старый 30.01.2012, 16:38   #2
Develop
Пользователь
 
Регистрация: 26.06.2010
Сообщений: 52
По умолчанию

Всё уже придумано до нас)) Возьми готовое и не парь себе мозги. xDD
http://pastebin.com/jVPqAXyV
Develop вне форума Ответить с цитированием
Старый 01.02.2012, 10:50   #3
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Отрефакторил и исправил в прохождении пути and на or, вроде работает: http://ideone.com/akmJd


Код:
uses
    crt;
 
const
    MAXX = 20;
    MAXY = 25;
 
type
    TArr = array [0..MAXY, 0..MAXX] of integer;
 
    TCell = record
        x: integer;
        y: integer;
    end;
 
    TListCell = record
        x: integer;
        y: integer;
        G: integer;
        parent: TCell;
    end;
 
    TListArr = array [1..10000] of TListCell;
 
    TList = record
        arr: TListArr;
        len: integer;
    end;
 
var
    i, j, minind, ind, c: integer;
    start, finish: TCell;
    current: TListCell;
    field: TArr;
    opened, closed: TList;
 
procedure ShowField;
var
    i, j: integer;
begin
    textcolor(15);
    for i := 0 to MAXX do
    begin
        for j := 0 to MAXY do
        begin
            case field[j, i] of
                99: textcolor(8);  // непроходимая
                71: textcolor(14); // проходимая
                11: textcolor(10); // старт
                21: textcolor(12); // финиш
                15: textcolor(2);  // путь
                14: textcolor(5);
                16: textcolor(6);
            end;
            write(field[j, i], ' ');
        end;
        writeln;
    end;
    textcolor(15);
end;
 
 
 
procedure AddClosed(a: TListCell);
begin
    closed.arr[closed.len + 1] := a;
    inc(closed.len);
end;
 
 
procedure AddOpened(x, y, G: integer);
begin
    opened.arr[opened.len + 1].x := x;
    opened.arr[opened.len + 1].y := y;
    opened.arr[opened.len + 1].G := G;
    inc(opened.len);
end;
 
procedure DelOpened(n: integer);
var
    i: integer;
begin
    AddClosed(opened.arr[n]);
    for i := n to opened.len - 1 do
        opened.arr[i] := opened.arr[i + 1];
    dec(opened.len);
end;
 
 
procedure SetParent(var a: TListCell; parx, pary: integer);
begin
    a.parent.x := parx;
    a.parent.y := pary;
end;
 
 
function GetMin(var a: TList): integer;
var
    i, min, mini: integer;
begin
    min := MaxInt;
    mini := 0;
    for i := 1 to a.len do
        if a.arr[i].G < min then
        begin
            min := a.arr[i].G;
            mini := i;
        end;
 
    GetMin := mini;
end;
 
 
function FindCell(a: TList; x, y: integer): integer;
var
    i: integer;
begin
    FindCell := 0;
    for i := 1 to a.len do
        if (a.arr[i].x = x) and (a.arr[i].y = y) then
        begin
            FindCell := i;
            break;
        end;
end;
 
 
procedure ProcessNeighbourCell(x, y: integer);
begin
    if (field[current.x + x, current.y + y] <> 99) then    // если проходима
        if (FindCell(closed, current.x + x, current.y + y) <= 0) then // и еще не посещена
            if (FindCell(opened, current.x + x, current.y + y) <= 0) then // и еще не добавлена в список
            begin
                AddOpened(current.x + x, current.y + y, current.G + 10);
                SetParent(opened.arr[opened.len], current.x, current.y); 
            end
                else
            begin
 
            end;
end;
 
 
begin
    randomize;
    for i := 0 to MAXX do
        for j := 0 to MAXY do
            field[j, i] := 99;
 
    for i := 1 to MAXX - 1 do
        for j := 1 to MAXY - 1 do
            if random(5) mod 5 = 0 then
                field[j, i] := 99
            else field[j, i] := 71;
 
    // координаты начальной и конечной позиций
    start.x := 5;
    start.y := 3;
 
    finish.x := 19;
    finish.y := 16;
 
    field[start.x, start.y] := 11;
    field[finish.x, finish.y] := 21;
 
    ShowField;
 
    writeln;
 
    opened.len := 0;
    closed.len := 0;
    AddOpened(start.x, start.y, 0);
    SetParent(opened.arr[opened.len], -1, -1);
    current.x := start.x;
    current.y := start.y;
 
    repeat
        minind := GetMin(opened);
        current.x := opened.arr[minind].x;
        current.y := opened.arr[minind].y;
        current.G := opened.arr[minind].G; 
        DelOpened(minind); 
 
        ProcessNeighbourCell(1, 0);  // проверить ячейку справа
        ProcessNeighbourCell(-1, 0); // проверить ячейку слева
        ProcessNeighbourCell(0, 1);  // проверить ячейку сверху
        ProcessNeighbourCell(0, -1); // проверить ячейку снизу
 
        if (FindCell(opened, finish.x, finish.y) > 0) then
            break;
    until opened.len = 0;
 
    // считаем и отмечаем обратный путь
    c := 0;
    while ((current.x <> start.x) or (current.y <> start.y)) do
    begin
        field[current.x, current.y] := 15;
        ind := FindCell(closed, current.x, current.y);
        current.x := closed.arr[ind].parent.x;
        current.y := closed.arr[ind].parent.y;
        inc(c);
    end; 
 
    ShowField;
    writeln(c);
    readln;
end.
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.

Последний раз редактировалось Alex11223; 16.05.2019 в 20:48.
Alex11223 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Алгоритм Флойда. Поиск Кратчайшего пути. Shady Помощь студентам 5 06.10.2014 18:29
Поиск самого дешёвого пути. Волновой алгоритм girlbuuuger Помощь студентам 16 13.02.2012 20:39
алгоритм поиска пути Ksssssssu Общие вопросы C/C++ 0 06.05.2011 13:05
Поиск кратчайшего пути. Алгоритм Дейкстры Blond_89 Паскаль, Turbo Pascal, PascalABC.NET 0 01.06.2010 21:25