![]() |
Начальные контакты ТОЛЬКО через личку!!
![]() |
Kubus |
![]()
Сообщение
#1
|
Группа: Пользователи Сообщений: 9 Пол: Мужской Репутация: ![]() ![]() ![]() |
приветствую, требуется срочное выполнение двух заданий по дискретной математике.
задание: 1)В заданном графе найти кратчайший путь от одной вершины к другой и найти все пути между этими вершинами, не пересекающиеся по вершинам. вот исходник: Код {Bellman-Ford algorithm} var a : array [1..20,1..20] of word; c, pred : array [1..20] of word; i, j, k, n, first, last : byte; f, g : text; begin assign(f,'in.txt'); reset(f); readln(f, n); for i := 1 to n do begin for j := 1 to n do read(f, a[i,j]); readln(f); end; readln(f, first, last); close(f); for j := 1 to n do begin c[j] := a[first,j];if a[first,j] < 32767 then pred[j] := first; end; for i := 3 to n do for j := 1 to n do if j <> first then for k := 1 to n do if (c[k] < 32767) and (c[k] + a[k,j] < c[j]) then begin c[j] := c[k] + a[k,j];pred[j] := k;end; assign(g,'out.txt'); rewrite(g); if c[last] = 32767 then writeln(g,'N') else begin writeln(g,'Y'); write(g,first,' '); i := last;k := 1; while i <> first do begin a[1,k] := i; k := k + 1; i := pred[i]; end; for i := k - 1 downto 1 do write(g,a[1,i],' '); writeln(g); writeln(g,c[last]); end; close(g); end. требуется, чтоб матрица смежности забивалась нулями и единицами, и чтоб на выходе была последовательность из номеров пути 2)написать программу, проверяющую заданный граф на двудольность. требования такие же, матрица смежности из единиц и нулей, на выходе фраза, типа, граф двудольный, или наоборот вот, что есть у меня Код {Proverka dvudolnosti grafa} const nv = 20; type pz = ^z; z = record v : byte; next : pz; end; var a : array [1..nv,1..nv] of byte; cc : array [1..nv] of byte; i, j, n, c : byte; f, g : text; top, p : pz; begin assign(f,'in.txt'); assign(g,'out.txt'); rewrite(g); reset(f); readln(f,n); for i := 1 to n do begin read(f,a[i,1]); j := 2; while a[i,j-1] > 0 do begin read(f,a[i,j]); j := j + 1; end; end; close(f); new(top); top^.next := nil; top^.v := 1; cc[1] := 1; c := 2; while top <> nil do begin j := 1; while (a[top^.v,j] > 0)and(cc[a[top^.v,j]] > 0) do begin if cc[a[top^.v,j]] <> c then begin writeln(g,'N');close(g); exit;end; j := j + 1; end; if a[top^.v,j] > 0 then begin cc[a[top^.v,j]] := c;c := c and 1 + 1; new(p); p^.v := a[top^.v,j]; p^.next := top; top := p; end else begin p := top^.next;dispose(top);top := p;c := cc[top^.v] and 1 + 1;end; end; writeln(g,'Y'); j := 1; while cc[j] > 0 do begin if cc[j] = cc[1] then write(g,j,' ');j := j + 1;end; write(g,'0'); writeln(g); j := 1; while cc[j] > 0 do begin if cc[j] = cc[1] and 1 + 1 then write(g,j,' ');j := j + 1;end; close(g); end. |
![]() ![]() |
![]() |
Текстовая версия | 23.07.2025 15:21 |