Форум программистов, компьютерный форум, киберфорум
Pascal (Паскаль)
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.78/9: Рейтинг темы: голосов - 9, средняя оценка - 4.78
0 / 0 / 0
Регистрация: 18.12.2009
Сообщений: 6
1

Волновой алгоритм(этап создания маршрута)

25.12.2009, 21:48. Показов 1708. Ответов 3
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
есть код для нахождение минимального пути в лабиринте

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146

program labyrinth;
 
var Map : array [1..10, 1..10] of integer =
           (    (255, 255, 255, 255, 255, 255, 255, 255, 255, 255),
                (255, 254, 254, 255, 254, 254, 255, 255, 254, 255),
                (255, 254, 254, 254, 254, 255, 254, 255, 254, 255),
                (255, 254, 255, 254, 255, 255, 254, 255, 254, 255),
                (255, 254, 254, 254, 254, 254, 254, 254, 254, 255),
                (255, 255, 255, 254, 255, 255, 254, 255, 254, 255),
                (255, 254, 255, 254, 255, 253, 254, 255, 254, 255),
                (255, 254, 255, 254, 255, 255, 255, 255, 255, 255),
                (255, 254, 254, 254, 254, 254, 254, 254, 0, 255),
                (255, 255, 255, 255, 255, 255, 255, 255, 255, 255));
    track:array[1..10, 1..10] of integer;
    Way:array [1..10,1..10] of string;
    i,j:integer;
    moves:integer = 0;
    moves1:integer = 0;
    counts:integer = 100;
    counts1:integer = 100;
    flag:boolean = true;    
    trigger:boolean = true;
    startX,startY:integer;
 
begin
// map viewer
for i := 1 to 10 do
    begin
        for j := 1 to 10 do
        begin
            if Map[i,j] = 255 then Way[i,j] := '*' else Way[i,j] := ' ';
                write(Way[i,j]:2);
            end;
            writeln;
        end;
 
// track dummy filler
for i := 1 to 10 do
    begin
        for j := 1 to 10 do
        begin
            track[i,j]:=252
        end;
    end;
 
// waves extension
while Flag do
begin
Flag:= false;
for i:= 1 to 10 do
begin
    for j:=1 to 10 do
    begin
        if map[i,j] = moves then 
        begin
                if map[i+1,j] = 254 then begin map[i+1,j] := moves+1;
                flag:=true; end;
                
                if map[i,j+1] = 254 then begin map[i,j+1] := moves+1;
                flag:=true; end;
                
                if map[i-1,j] = 254 then begin map[i-1,j] := moves+1;
                flag:=true; end;
                
                if map[i,j-1] = 254 then begin map[i,j-1] := moves+1; 
                flag:=true; end;
 
        end;
    end;
end;
if moves > counts then flag:=false else moves:=moves+1; // checking for limit
 
end;//flag
 
writeln;
// debug map viewing
for i := 1 to 10 do
    begin
        for j := 1 to 10 do
        begin
            if Map[i,j] = 255  then 
                            begin
                                write(map[i,j]: 4);
                            end
                             else
                            begin
                            write(Map[i,j]:4);
                            end;
                            
            end;
            writeln;
        end;
        
// start points´ assigning
for i := 1 to 10 do
    begin
        for j := 1 to 10 do
        begin
            if map[i,j] = 253 then begin startX := i; startY := j; end;
        end;
    end;
 
// Track
while Trigger do
begin
Trigger:=false;
for i := 1 to 10 do
begin
    for j:= 1 to 10 do
    begin
        if map[i,j] = map[startX,startY] then  
        begin
            if (map[i+1,j] < map[i,j+1]) and (map[i+1,j]<map[i-1,j]) and (map[i+1,j]<map[i,j-1]) then 
                begin startX := i+1; startY:= j; track[i+1,j]:=map[i+1,j]; moves1:=moves1+1; Trigger:=true; end;
            
            if(map[i,j+1] < map[i+1,j]) and (map[i,j+1]<map[i-1,j]) and (map[i,j+1]<map[i,j-1]) then 
                    begin  startX := i; startY:= j+1; track[i,j+1]:=map[i,j+1]; moves1:=moves1+1; Trigger:=true;end;
                    
            if(map[i-1,j] < map[i+1,j]) and (map[i-1,j]<map[i,j+1]) and (map[i-1,j]<map[i,j-1]) then 
                    begin  startX := i-1; startY:= j; track[i-1,j]:=map[i-1,j]; moves1:=moves1+1; Trigger:=true; end;
            
            if(map[i,j-1] < map[i+1,j]) and (map[i,j-1]<map[i,j+1]) and (map[i,j-1]<map[i-1,j]) then 
                    begin  startX := i-1; startY:= j; track[i,j-1]:=map[i,j-1];  moves1:=moves1+1;Trigger:=true; end;
        end;
    end;
end;
if moves > counts1 then trigger:=false;
 
end;// trigger
 
writeln;
for i := 1 to 10 do
    begin
        for j := 1 to 10 do
        begin
            if track[i,j] = 252 then 
                write(way[i,j]: 3)
            else
                write(track[i,j]: 3);
        end;
            writeln;
        end;
        
 
 
end.
результат его выполнения таков:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

 * * * * * * * * * *
 *     *     * *   *
 *         *   *   *
 *   *   * *   *   *
 *                 *
 * * *   * *   *   *
 *   *   *     *   *
 *   *   * * * * * *
 *                 *
 * * * * * * * * * *
 
 255 255 255 255 255 255 255 255 255 255
 255  14  13 255  13  14 255 255  17 255
 255  13  12  11  12 255  14 255  16 255
 255  12 255  10 255 255  13 255  15 255
 255  11  10   9  10  11  12  13  14 255
 255 255 255   8 255 255  13 255  15 255
 255   9 255   7 255 253  14 255  16 255
 255   8 255   6 255 255 255 255 255 255
 255   7   6   5   4   3   2   1   0 255
 255 255 255 255 255 255 255 255 255 255
 
  *  *  *  *  *  *  *  *  *  *
  *        *        *  *     *
  *    12 11     *     *     *
  *     * 10  *  *     *     *
  *        9                 *
  *  *  *  8  *  * 13  *     *
  *     *  7  *    14  *     *
  *     *  6  *  *  *  *  *  *
  *        5  4  3  2  1  0  *
  *  *  *  *  *  *  *  *  *  *

первые 2 выведенных лабиринта служат для отладки и не суть важны.
Сам трабл заключается в 3 лабиринте(выводится из массива track)
Pascal
1
2
3
4
5
6
7
8
9
10

  *  *  *  *  *  *  *  *  *  *
  *        *        *  *     *
  *    12 11     *     *     *
  *     * 10  *  *     *     *
  *        9                 *
  *  *  *  8  *  * 13  *     *
  *     *  7  *    14  *     *
  *     *  6  *  *  *  *  *  *
  *        5  4  3  2  1  0  *
  *  *  *  *  *  *  *  *  *  *
от конечной точки путь строится по принципу где меньшее значение массива в окрестностях точки map[i,j], то туда и идём(присваеваем значение startX и startY и от точки map[startx,starty] начинаем новую итерацию)

и так далее пока не дойдём до нуля(т.е. конечной точки),
но после отметки 13, путь внезапно начинает отсчёт от совсем другого конца массива(как сами видите - это 12).
Есть идеи как это пофиксить?
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 25.12.2009, 21:48
Ответы с готовыми решениями:

Волновой алгоритм
Уважаемые форумчани,нужна ваша помощь,вот никак нигде в интернете не могу найти нормального примера...

Волновой алгоритм
Ребята помогите.Есть программа.В ней нужно изменить сам волновой алгоритм таким образом, чтобы...

Волновой алгоритм
Здравствуйте, можно ли модифицировать волновой алгоритм, чтобы он считал не количество шагов, а...

Нужен алгоритм поиска пути в этом лабиринте (будь то волновой алгоритм или алгоритм правой/левой руки )
#include &quot;stdafx.h&quot; #include &lt;iostream&gt; #include &lt;conio.h&gt; using namespace std; void lab...

3
175 / 172 / 40
Регистрация: 14.11.2009
Сообщений: 507
25.12.2009, 23:28 2
слишком нерациональный код,я полегче делал,и все работало,могу скинуть если надо,правда там был про крысу и сыр,но подправить несколько строк не сложно

Добавлено через 6 минут
и вместе "*" лучше писать -2 или еще что-нибудь ,это только осложняет алгоритм.
0
3067 / 727 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
26.12.2009, 01:28 3
pikusfikus, Выкладывайте Вашу реализацию, будет интересно глянуть.
1
175 / 172 / 40
Регистрация: 14.11.2009
Сообщений: 507
26.12.2009, 01:35 4
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138

program n4;
var m,n,min,min1,x,y,x1,x2,x3,y1,y2,y3,i,j,k,p,s,k1:integer;
a:array[1..4] of integer;
b:array[1..100,1..100] of integer;
c:array[1..100] of integer;
label
1;
begin
writeln('vvedit rozmiru m,n');
readln(m,n);
for i:=1 to m do begin
for j:=1 to n do
b[i,j]:=254;
end;
writeln('koordunaty mushi');
readln(x1,y1);
b[x1,y1]:=0;
writeln('koordunatu sury');
readln(x2,y2);
b[x2,y2]:=253;
writeln('vvedit kil-st zaboronunux klitun');
readln(p);
if p>0 then begin
writeln('koordunatu zaboronenux klitunu');
for i:=1 to p do begin
readln(x3,y3);
b[x3,y3]:=255;
end;
end;
 
s:=0;
 
repeat
for i:=1 to m   do
for j:=1 to n   do
if b[i,j]=s  then   begin
if b[i+1,j]=254 then b[i+1,j]:=s+1;
if b[i-1,j]=254 then b[i-1,j]:=s+1;
if b[i,j+1]=254 then b[i,j+1]:=s+1;
if b[i,j-1]=254 then b[i,j-1]:=s+1;
end;
inc(s);
until (b[x2-1,y2]=s) or (b[x2+1,y2]=s) or (b[x2,y2-1]=s) or (b[x2,y2+1]=s);
 
a[1]:=b[x2-1,y2];
a[2]:=b[x2+1,y2];
a[3]:=b[x2,y2-1];
a[4]:=b[x2,y2+1];
min:=400;
 
for i:=1 to 4 do
if (a[i]<min) and (a[i]<>0) and (a[i]<>254) and (a[i]<>255) then min:=a[i];
 
if (b[x2-1,y2]<>min) and (b[x2+1,y2]<>min) and (b[x2,y2+1]<>min)
and (b[x2,y2-1]<>min) then begin
writeln('NO SOLUTION');
goto 1;
exit;
end;
 
if (b[x1-1,y1]=253) or (b[x1+1,y1]=253) or (b[x1,y1-1]=253)
or (b[x1,y1+1]=253) then begin
writeln('min shljax = 1');
write('(',x1,' ',y1,')',' ');
writeln('(',x2,' ',y2,')',' ');
goto 1;
end;
 
writeln('min shljax = ',min+1);
k:=0;
x:=x2;
y:=y2;
for i:=1 to m do
for j:=1 to n do begin
if (b[x,y-1]=min) then begin
dec(min);
x:=x;
y:=y-1;
inc(k);
c[k]:=x;
inc(k);
c[k]:=y;
end
else
if (b[x,y+1]=min) then begin
dec(min);
x:=x;
y:=y+1;
inc(k);
c[k]:=x;
inc(k);
c[k]:=y;
end
else
if (b[x+1,y]=min) then begin
dec(min);
x:=x+1;
y:=y;
inc(k);
c[k]:=x;
inc(k);
c[k]:=y;
end
else
if (b[x-1,y]=min) then begin
dec(min);
x:=x-1;
y:=y;
inc(k);
c[k]:=x;
inc(k);
c[k]:=y;
end;
end;
 
j:=0;
write('(',x1,' ',y1,')',' ');
for i:=k-2 downto 1 do begin
inc(j);
if j=2 then begin
inc(k1);
j:=0;
write('(',c[i],' ',c[i+1],')',' ');
if k1=10 then begin
writeln;
k1:=0;
end;
end;
end;
writeln('(',x2,' ',y2,')',' ');
writeln;
 
1:for i:=1 to m do begin
for j:=1 to n do
write(b[i,j]:5);
writeln;
end;
end.
Добавлено через 2 минуты
конечно я не говорю что это самый рациональный способ ,но всё же работает)
2
26.12.2009, 01:35
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 26.12.2009, 01:35
Помогаю со студенческими работами здесь

Волновой алгоритм поиска (Алгоритм A* / Алгоритм А стар)
Хочу разработать алгоритм для решения головоломки с подвижными дисками (перестановочная...

Волновой алгоритм
Нужно реализовать волновой алгоритм поиска кратчайшего пути на поле 20*20, причем координаты начала...

Волновой алгоритм
Делал ради интереса. Если кому надо - тут исходники и откомпиленный файл.

Волновой алгоритм
Подскажите пожалуйста, на сколько сложно изготовить из матрицы 0000 0000 0000 напр.4345 3234...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru