|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
21.04.2018, 21:16 | #1 |
Регистрация: 21.04.2018
Сообщений: 4
|
Найти ошибку в работе с вершинами
При работе с вершинами пути вышел ресурсию. На основе используется алгоритм Дейстры. Иду по алгоритму Дейстры, для нахождения сначала общего пути, для разбора определённых вершин.
Ошибка в процедуре Find program Pousk; var O,M:integer; MatrixKart:array[1..10,1..10] of integer; lol:integer; procedure OpenKart; var f:text; i,j:integer; begin assign(f,'karta.txt'); reset(f); read(f,O); read(f,M); for i:=1 to O do begin for j:=1 to M do begin read(f,MatrixKart[i,j]); write(MatrixKart[i,j]:4); end; writeln; end; close(f); end; procedure MatrixPute;//Карта пути var O,M:integer; i,j:integer; Matrix:array [1..10,1..10] of integer; f: text; n: byte; begin write('Введите количество офисов - '); readln(O); write('Введите количество магазинов - '); readln(M); for i:=1 to O do begin for j:=1 to M do begin write('Введите растояние от Офиса ',i,' до Магазина ',j,': '); readln(Matrix[i,j]); end; end; writeln('Готовый массив - карта'); for i:=1 to O do begin for j:=1 to M do begin write(Matrix[i,j]); end; writeln; end; //Запись массива в файл assign (f, 'karta.txt'); rewrite (f); write(f,O:4); write(f,M:4); writeln(f,''); for i := 1 to O do begin for j :=1 to M do begin n := Matrix[i,j]; write (f, n:4) end; writeln (f) end; close (f); OpenKart; end; procedure Find(number:integer); var i,j,temp,minindex, min:integer; d,v:array[1..100] of integer; // Восстановление пути ver:array[1..100] of integer; // массив посещенных вершин endd,k,l,weight:integer; begin //Инициализация вершин и расстояний endd := O; // индекс конечной вершины = 5 - 1 ver[1] := endd + 1; // начальный элемент - конечная вершина k := 1; // индекс предыдущей вершины weight := d[endd]; // вес конечной вершины for i:= 1 to O do begin d[i] := 10000; v[i] := 1; end; d[1] := 0; // Шаг алгоритма repeat begin minindex := 10000; min := 10000; for i:= 1 to O do begin // Если вершину ещё не обошли и вес меньше min if ((v[i] = 1)> (d[i]<min)) then begin // Переприсваиваем значения min := d[i]; minindex := i; end; end; // Добавляем найденный минимальный вес // к текущему весу вершины // и сравниваем с текущим минимальным весом вершины if (minindex <> 10000) then begin for i:= 1 to O do begin if (MatrixKart[minindex][i] > 0) then begin temp := min + MatrixKart[minindex][i]; if (temp < d[i]) then begin d[i] := temp; end; end; end; v[minindex] := 0; end; end; until (minindex < 10000); while (endd > 0) do// пока не дошли до начальной вершины begin for i:=1 to O do// просматриваем все вершины if (MatrixKart[endd][i] <> 0) then // если связь есть begin temp := weight - MatrixKart[endd][i]; // определяем вес пути из предыдущей вершины if (temp = d[i]) then// если вес совпал с рассчитанным begin // значит из этой вершины и был переход weight := temp; // сохраняем новый вес endd := i; // сохраняем предыдущую вершину ver[k] := i + 1; // и записываем ее в массив k:=k+1; end; end; end; // Вывод пути (начальная вершина оказалась в конце массива из k элементов) writeln('Вывод кратчайшего пути'); for i:=k-1 downto 0 do writeln(ver[i]:4); end; procedure Choose(O:integer;M:integer); var number,i:integer; begin writeln('Количество офисов: ',O); writeln('Количество магазинов: ',M); write('Введите офис из которого выезжаете: '); readln(number); Find(number); end; begin write('Создать(1) или открыть карту(2)'); readln(lol); if (lol=1) then MatrixPute else OpenKart; Choose(O,M); end. |
22.04.2018, 03:20 | #2 |
Цифровой кот
Старожил
Регистрация: 29.08.2014
Сообщений: 7,629
|
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
|
22.04.2018, 10:56 | #3 |
Регистрация: 21.04.2018
Сообщений: 4
|
Пожалуйста
|
22.04.2018, 10:59 | #4 | ||
Старожил
Регистрация: 20.04.2008
Сообщений: 5,526
|
Цитата:
Цитата:
программа — запись алгоритма на языке понятном транслятору
|
||
23.04.2018, 23:52 | #5 |
Регистрация: 21.04.2018
Сообщений: 4
|
Вот собственно исправил, только кратчайший путь ищет не правильно, помогите пожалуйста исправить
Код:
________ Код нужно оформлять по правилам: тегом [CODE]..[/СODE] (это кнопочка на панели форматирования с решёточкой #) Не забывайте об этом! Модератор. Последний раз редактировалось Serge_Bliznykov; 24.04.2018 в 00:05. |
24.04.2018, 09:54 | #6 | |
Старожил
Регистрация: 20.04.2008
Сообщений: 5,526
|
Цитата:
читайте Warning(и старайтесь исправить). там все это есть(сказано).
программа — запись алгоритма на языке понятном транслятору
Последний раз редактировалось evg_m; 24.04.2018 в 09:59. |
|
24.04.2018, 10:53 | #7 |
Регистрация: 21.04.2018
Сообщений: 4
|
Помогите исправить
На что заменить то ? Помогите исправить чтобы работало. Голова уже не варит
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Даны координаты трёх точек, являющихся вершинами некоторого параллелограмма. Найти координаты четвертой вершины. | yamato_pm | Паскаль, Turbo Pascal, PascalABC.NET | 1 | 18.12.2013 19:42 |
Помогите найти ошибку - StrToFloat выдаёт ошибку EConvertError для ячеек StringGrid (Delphi) | Artsiom | Помощь студентам | 10 | 18.12.2013 14:10 |
Найти треугольник с наибольшей площадью с вершинами в точках заданных координатами (подправить код) C++ | GrShOot | Помощь студентам | 0 | 28.05.2013 01:47 |
Дано 3 точки своими координатами х,у. Будет ли они вершинами треугольника. Если да - найти периметр и площадь треугольника | Arhi555 | Паскаль, Turbo Pascal, PascalABC.NET | 2 | 11.09.2012 17:46 |