Форум программистов, компьютерный форум, киберфорум
PascalABC.NET
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
0 / 0 / 0
Регистрация: 03.06.2015
Сообщений: 5

Задача коммивояжера муравьиным алгоритмом

03.06.2015, 23:29. Показов 1012. Ответов 0
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Помогите дописать программу на PascalABC.NET. Программа должна выводить расстояния и стороить график минимального из всех. Программу я брала с книги Тима Джонса "Программирование искуственного интеллекта в приложениях" глава 4 "Алгоритм муравья".
Вот код программы который у меня получился после перевода его на PascalABC.NET
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
const
  MAX_CITIES = 30;
 
const
  MAX_DISTANCE = 100;
 
const
  MAX_TOUR = MAX_CITIES * MAX_DISTANCE;
 
type
  cityType = record x, y: integer;
  end;
 
const
  MAX_ANTS = 30;
 
type
  antType = record curCity, nextCity: integer;
    tabu: array [0..MAX_CITIES] of byte;
    pathIndex: integer;
    path: array [0..MAX_CITIES] of byte;
    tourLenght: real;
  end;
 
const
  ALPHA = 1.0;
 
const
  BETA = 5.0;
 
const
  RHO = 0.5;
 
const
  QVAL = 100;
 
const
  MAX_TOURS = 20;
 
const
  MAX_TIME = (MAX_TOURS * MAX_CITIES);
 
const
  INIT_PHEROMONE = (1.0 / MAX_CITIES);
 
var
  cities: array [0..MAX_CITIES] of cityType;
  ants: array [0..MAX_ANTS] of antType;
  distance: array [0..MAX_CITIES, 0..MAX_CITIES] of real;
  pheromone: array [0..MAX_CITIES, 0..MAX_CITIES] of real;
  best: real := MAX_TOUR;
  bestIndex: integer;
 
function getRand(max: integer): integer;
 
begin
  getRand := random(max);
end;
 
procedure init;
 
var
  from, tot, ant: integer;
 
begin
  for from := 0 to MAX_CITIES - 1 do 
  
  begin
    cities[from].x := getRand(MAX_DISTANCE);
    cities[from].y := getRand(MAX_DISTANCE);
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      distance[from, tot] := 0.0;
      pheromone[from, tot] := INIT_PHEROMONE;
    end;
  end;
  
  for from := 0 to MAX_CITIES - 1 do
  
  begin
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      if ((tot <> from) and (distance[from, tot] = 0.0)) then 
      
      begin
        var xd, yd: integer;
        xd := abs(cities[from].x - cities[tot].x);
        yd := abs(cities[from].y - cities[tot].y);
        distance[from, tot] := sqrt((xd * xd) + (yd * yd));
        distance[tot, from] := distance[from, tot];
      end;
    end;
  end;
  
    
  tot := 0;
  
  for ant := 0 to MAX_ANTS - 1 do
  
  begin
    if tot = MAX_CITIES then tot := 0;
    ants[ant].curCity := tot;
    inc(tot);
    for from := 0 to MAX_CITIES - 1 do
    
    begin
      ants[ant].tabu[from] := 0;
      ants[ant].path[from] := -1;
    end;
    
    ants[ant].pathIndex := 1;
    ants[ant].path[0] := ants[ant].curCity;
    ants[ant].nextCity := -1;
    ants[ant].tourLenght := 0.0;
    ants[ant].tabu[ants[ant].curCity] := 1;
  end;
end;
 
procedure restartAnts;
 
var
  ant, i: integer;
  tot := 0;
 
begin
  for ant := 0 to MAX_ANTS - 1 do 
  
  begin
    if (ants[ant].tourLenght < best) then 
    
    begin
      best := ants[ant].tourLenght;
      bestIndex := ant;
    end;
    
    ants[ant].nextCity := -1;
    ants[ant].tourLenght := 0.0;
    for i := 0 to MAX_CITIES - 1 do
    
    begin
      ants[ant].tabu[i] := 0;
      ants[ant].path[i] := -1;
    end;
    
    if tot = MAX_CITIES then tot := 0;
    ants[ant].curCity := tot;
    inc(tot);
    ants[ant].pathIndex := 1;
    ants[ant].path[0] := ants[ant].curCity;
    ants[ant].tabu[ants[ant].curCity] := 1;
  end;
end;
 
 
function antProduct(from, tot: integer): real;
 
begin
  antProduct := ((power(pheromone[from, tot], ALPHA) * power((1.0 / distance[from, tot]), BETA)));
end;
 
function selectNextCity(ant: integer): integer;
 
var
  from, tot: integer;
  denom: real := 0.0;
 
begin
  from := ants[ant].curCity;
  for tot := 0 to MAX_CITIES - 1 do
  
  begin
    if (ants[ant].tabu[tot] = 0) then
    
    begin
      denom := denom + antProduct(from, tot);
    end;
  end;
  
  while(denom <> 0.0) do
  
  begin
    var p: real;
    inc(tot);
    if (tot >= MAX_CITIES) then tot := 0;
    if (ants[ant].tabu[tot] = 0) then 
    
    begin
      p := antProduct(from, tot) / denom;
    end;
  end;
  
  result := tot;
end;
 
function simulateAnts: integer;
 
var
  k: integer;
  moving: integer := 0;
 
begin
  for k := 0 to MAX_ANTS - 1 do
  
  begin
    if(ants [k].pathIndex < MAX_CITIES) then
    
    begin
      ants[k].nextCity := selectNextCity(k);
      ants[k].tabu[ants[k].nextCity] := 1;
      ants[k].path[ants[k].pathIndex] := ants[k].nextCity;
      inc(ants[k].pathIndex);
      ants[k].tourLenght += distance[ants[k].curCity, ants[k].nextCity];
      if (ants[k].pathIndex = MAX_CITIES) then
      
      begin
        ants[k].tourLenght := ants[k].tourLenght + distance[ants[k].path[MAX_CITIES - 1], ants[k].path[0]];
      end;
      
      ants[k].curCity := ants[k].nextCity;
      inc(moving);
    end;
  end;
  
  result := moving;
end;
 
procedure updateTrails;
 
var
  from, tot, i, ant: integer;
 
begin
  for from := 0 to MAX_CITIES - 1 do
  
  begin
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      if (from <> tot) then
      
      begin
        pheromone[from, tot] := pheromone[from, tot] * (1.0 - RHO);
        if(pheromone [from][tot] < 0.0) then
          pheromone[from, tot] := INIT_PHEROMONE;
      end;
    end;
  end;
  
  for ant := 0 to MAX_ANTS - 1 do
  
  begin
    for i := 0 to MAX_CITIES - 1 do
    
    begin
      if (i < MAX_CITIES - 1) then
      
      begin
        from := ants[ant].path[i];
        tot := ants[ant].path[i + 1];
      end
      
      else 
      
      begin
        from := ants[ant].path[i];
        tot := ants[ant].path[0];
      end;
      
      pheromone[from, tot] := pheromone[from, tot] + (QVAL / ants[ant].tourLenght);
      pheromone[tot, from] := pheromone[from, tot];
    end;
  end;
  
  for from := 0 to MAX_CITIES - 1 do
  
  begin
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      pheromone[from, tot] := pheromone[from, tot] * RHO;
    end;
  end;
end;
 
procedure main;
 
var
  curTime: integer := 0;
 
begin
  randomize;
  init();
  while (curTime < MAX_TIME) do
  
  begin
    inc(curTime);
    if (simulateAnts() = 0) then
    
    begin
      updateTrails();
      if (curTime <> MAX_TIME) then
        restartAnts();
      writeln('Time is ', curTime, ' (', best, ' ) ');
    end;
  end;
  
  writeln('best tour ', best);
end.
Добавлено через 9 часов 57 минут
исправила некоторые ошибки, теперь задача компилируется, но ничего не выводит =(
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
const
  MAX_CITIES = 30;
 
const
  MAX_DISTANCE = 100;
 
const
  MAX_TOUR = MAX_CITIES * MAX_DISTANCE;
 
type
  cityType = record x, y: integer;
  end;
 
const
  MAX_ANTS = 30;
 
type
  antType = record curCity, nextCity: integer;
    tabu: array [0..MAX_CITIES] of byte;
    pathIndex: integer;
    path: array [0..MAX_CITIES] of byte;
    tourLenght: real;
  end;
 
const
  ALPHA = 1.0;
 
const
  BETA = 5.0; //приоритет расстояния над кол-вом фермента
 
const
  RHO = 0.5; // интенсивность испарения
 
const
  QVAL = 100;
 
const
  MAX_TOURS = 20;
 
const
  MAX_TIME = (MAX_TOURS * MAX_CITIES);
 
const
  INIT_PHEROMONE = (1.0 / MAX_CITIES);
 
var
  cities: array [0..MAX_CITIES] of cityType;
  ants: array [0..MAX_ANTS] of antType;
  distance: array [0..MAX_CITIES, 0..MAX_CITIES] of real; // [из, в] 
  pheromone: array [0..MAX_CITIES, 0..MAX_CITIES] of real; // [из, в]
  best: real := MAX_TOUR;
  bestIndex: integer;
 
function getRand(max: integer): integer;
 
begin
  getRand := random(max);
end;
 
procedure init;
 
var
  from, tot, ant: integer;
 
begin
 
// создание городов
 
  for from := 0 to MAX_CITIES - 1 do 
  
  begin
  
// случайным образом распологаем города
  
    cities[from].x := getRand(MAX_DISTANCE);
    cities[from].y := getRand(MAX_DISTANCE);
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      distance[from, tot] := 0.0;
      pheromone[from, tot] := INIT_PHEROMONE;
    end;
  end;
  
// вычисляем расстояние между городами
  
  for from := 0 to MAX_CITIES - 1 do
  
  begin
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      if ((tot <> from) and (distance[from, tot] = 0.0)) then 
      
      begin
        var xd := abs(cities[from].x - cities[tot].x);
        var yd := abs(cities[from].y - cities[tot].y);
        distance[from, tot] := sqrt((xd * xd) + (yd * yd));
        distance[tot, from] := distance[from, tot];
      end;
    end;
  end;
   
//инициализация муравьев
  
  tot := 0;
  
  for ant := 0 to MAX_ANTS - 1 do
  
  begin
  
// распределяем муравьев по городам равномерно
  
    if tot = MAX_CITIES then tot := 0;
    ants[ant].curCity := tot;
    inc(tot);
    for from := 0 to MAX_CITIES - 1 do
    
    begin
      ants[ant].tabu[from] := 0;
      ants[ant].path[from] := -1;
    end;
    
    ants[ant].pathIndex := 1;
    ants[ant].path[0] := ants[ant].curCity;
    ants[ant].nextCity := -1;
    ants[ant].tourLenght := 0.0;
    
// помещаем исходный город, в котором находится муравей, в список табу
    
    ants[ant].tabu[ants[ant].curCity] := 1;
  end;
end;
 
procedure restartAnts;
 
var
  ant, i: integer;
  tot := 0;
 
begin
  for ant := 0 to MAX_ANTS - 1 do 
  
  begin
    if (ants[ant].tourLenght < best) then 
    
    begin
      best := ants[ant].tourLenght;
      bestIndex := ant;
    end;
    
    ants[ant].nextCity := -1;
    ants[ant].tourLenght := 0.0;
    for i := 0 to MAX_CITIES - 1 do
    
    begin
      ants[ant].tabu[i] := 0;
      ants[ant].path[i] := -1;
    end;
    
    if tot = MAX_CITIES then tot := 0;
    ants[ant].curCity := tot;
    inc(tot);
    ants[ant].pathIndex := 1;
    ants[ant].path[0] := ants[ant].curCity;
    ants[ant].tabu[ants[ant].curCity] := 1;
  end;
end;
 
 
function antProduct(from, tot: integer): real;
 
begin
  antProduct := ((power(pheromone[from, tot], ALPHA) * power((1.0 / distance[from, tot]), BETA)));
end;
 
function selectNextCity(ant: integer): integer;
 
var
  from, tot: integer;
  denom: real := 0.0;
 
begin
 
// выбрать следующий город
 
  from := ants[ant].curCity;
  
// рассчет знаменателя
  
  for tot := 0 to MAX_CITIES - 1 do
  
  begin
    if (ants[ant].tabu[tot] = 0) then
    
    begin
      denom := denom + antProduct(from, tot);
    end;
  end;
  
  while(true) do
  
  begin
    var p: real;
    inc(tot);
    if (tot >= MAX_CITIES) then tot := 0;
    if (ants[ant].tabu[tot] = 0) then 
    
    begin
      p := antProduct(from, tot) / denom;
    end;
  end;
  
  result := tot;
end;
 
function simulateAnts: integer;
 
var
  k: integer;
  moving: integer := 0;
 
begin
  for k := 0 to MAX_ANTS - 1 do
  
  begin
  
// убедиться, что у муравья есть куда идти
  
    if(ants [k].pathIndex < MAX_CITIES) then
    
    begin
      ants[k].nextCity := selectNextCity(k);
      ants[k].tabu[ants[k].nextCity] := 1;
      ants[k].path[ants[k].pathIndex] := ants[k].nextCity;
      inc(ants[k].pathIndex);
      ants[k].tourLenght += distance[ants[k].curCity, ants[k].nextCity];
      
// обработка окончания путешествия (из последнего города в первый)
      
      if (ants[k].pathIndex = MAX_CITIES) then
      
      begin
        ants[k].tourLenght := ants[k].tourLenght + distance[ants[k].path[MAX_CITIES - 1], ants[k].path[0]];
      end;
      
      ants[k].curCity := ants[k].nextCity;
      inc(moving);
    end;
  end;
  
  result := moving;
end;
 
procedure updateTrails;
 
var
  from, tot, i, ant: integer;
 
begin
 
// испарение фермента
 
  for from := 0 to MAX_CITIES - 1 do
  
  begin
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      if (from <> tot) then
      
      begin
        pheromone[from, tot] := pheromone[from, tot] * (1.0 - RHO);
        if(pheromone [from][tot] < 0.0) then
          pheromone[from, tot] := INIT_PHEROMONE;
      end;
    end;
  end;
 
// нанесение нового фермента
// для пути каждого муравья
  
  for ant := 0 to MAX_ANTS - 1 do
  
  begin
  
// обновляем каждый шаг пути
  
    for i := 0 to MAX_CITIES - 1 do
    
    begin
      if (i < MAX_CITIES - 1) then
      
      begin
        from := ants[ant].path[i];
        tot := ants[ant].path[i + 1];
      end
      
      else 
      
      begin
        from := ants[ant].path[i];
        tot := ants[ant].path[0];
      end;
      
      pheromone[from, tot] := pheromone[from, tot] + (QVAL / ants[ant].tourLenght);
      pheromone[tot, from] := pheromone[from, tot];
    end;
  end;
  
  for from := 0 to MAX_CITIES - 1 do
  
  begin
    for tot := 0 to MAX_CITIES - 1 do
    
    begin
      pheromone[from, tot] := pheromone[from, tot] * RHO;
    end;
  end;
end;
 
var
  curTime: integer := 0;
 
begin
  randomize;
  init();
  while (curTime < MAX_TIME) do
  
  begin
    inc(curTime);
    if (simulateAnts() = 0) then
    
    begin
      updateTrails();
      if (curTime <> MAX_TIME) then
        restartAnts();
      writeln('Time is ', curTime, ' (', best, ' ) ');
    end;
  end;
  
  writeln('best tour ', best);
  writeln();
  writeln();
 
end.
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
03.06.2015, 23:29
Ответы с готовыми решениями:

Рекурсия: задача коммивояжера
Расстояния между городами заданы матрицей (Если между городами i,j есть прямой путь с расстоянием N, то элементы матрицы A(i,j) и A(j,i)...

Задача коммивояжера
привет всем. помогите написать программу, реализующую решение задачи коммивояжера размерностью 5*5. Программа должна: 1)позволять...

Задача Коммивояжера
Попалась значит такая вот халтурка, а с чего и начать, да и что да как не знаю. Если у кого есть исходники этой замечательной проги, то не...

0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
03.06.2015, 23:29
Помогаю со студенческими работами здесь

Задача коммивояжера
Думаю будет полезно выложить решение задачи на java. А то на мою просьбу дать пример, сказали, что на всех языках все уже 100 раз решено,...

Задача коммивояжера.
Может у кого-то есть решение задачи Коммивояжера (нужно посетить все вершины графа и вернуться в исходную с минимальными затратами) на...

Решить задачу коммивояжера
Помогите с решением пожалуйста . У коммивояжера есть 4 часа, чтобы посетить 4 своих потенциальных покупателей. Размер комиссионных...

Задача коммивояжера (C++ -> Си)
Задача коммивояжёра #include &lt;iostream&gt; using namespace std; const int inf=1E9,NMAX=16; int n,i,j,k,m,temp,ans,d,t; bool...

Задача Коммивояжера
Есть список валют: tickersList BTC_USD BTC_EUR BTC_RUB BTC_UAH BTC_PLN BCH_BTC


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

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Новые блоги и статьи
Как я обхитрил таблицу Word
Alexander-7 21.03.2026
Когда мигает курсор у внешнего края таблицы, и нам надо перейти на новую строку, а при нажатии Enter создается новый ряд таблицы с ячейками, то мы вместо нервных нажатий Энтеров мы пишем любые буквы. . .
Krabik - рыболовный бот для WoW 3.3.5a
AmbA 21.03.2026
без регистрации и смс. Это не торговля, приложение не содержит рекламы. Выполняет свою непосредственную задачу - автоматизацию рыбалки в WoW - и ничего более. Однако если админы будут против -. . .
Программный отбор значений справочника
Maks 21.03.2026
Установка программного отбора значений справочника "Сотрудники" из модуля формы документа. В качестве фильтра для отбора служит предопределенное значение перечислений. Процедура. . .
Переходник USB-CAN-GPIO
Eddy_Em 20.03.2026
Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .
Оттенки серого
Argus19 18.03.2026
Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .
SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++
8Observer8 17.03.2026
Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip
Символические и жёсткие ссылки в Linux.
algri14 15.03.2026
Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .
[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора
ФедосеевПавел 14.03.2026
Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru