PDA

Просмотр полной версии : Помогите написать программу



Ольга
15.12.2008, 09:38
Помогите сдать экзамен по Структурам и алгоритмам обработки данных. Необходимо написать на Паскале программу поиска кратчайшего пути на графе методом полного перебора в глубину (метод ветвей и границ). Смысл задачи понимаю, не понимаю как её программно реализовать.
P.S. данные о вершинах и весе каждой ветви должны считываться из текстового документа (граф берётся произвольный)


И ещё решить задачу о плотном расписании :ah: (ну это попроще):dh:

Champion
15.12.2008, 16:54
Всё понятно.Если будешь ещё сдавать экзамен по китайскому языку,дай знать-тоже подсобим.

ZIBY
15.12.2008, 19:56
Лучше например, сюда (http://forum.vingrad.ru/index.php?showtopic=38605) сходи...Там точно помогут...

Ольга
22.12.2008, 12:07
Спасибо, а не подскажешь, где ещё можно реализацию на Pascale задачи о плотном расписании взять?!

ZIBY
23.12.2008, 19:49
Ольга, да я в языках-то не особо.... даже простые задачи :ca:
Если не срочно, то возможно попозже спрошу у друзей или может в сети наткнусь...

ZIBY
28.12.2008, 13:52
Образовательно-студенческий форум (http://www.opeople.ru/index.html?)
неплохой вроде ресурс....
Для написания нужны условия( предметы, часы, или чё там ещё...)? Или тебе голый исходник нужен? Я тут у местных программеров поспрашивал, они просят для написания данные предоставить...

ZIBY
23.01.2009, 22:25
Спасибо, а не подскажешь, где ещё можно реализацию на Pascale задачи о плотном расписании взять?!

Ну что, выкладывать код задачи? Или уже не актуально?:ca:

Ольга
03.03.2009, 22:37
Выкладывай, поздно, правда, уже (экзамен сдала). Ну ничего, хоть знать буду.

ZIBY
03.03.2009, 22:49
В данной задаче речь идём о мксимальном паросочетании в двудольном графе (ПС: едва после 23 февраля нашёл на жёстком :ca: )


{$r+}
program rasspisanie;
uses crt;
const
n:integer=20;
k=12;
l=3;
type trebro=array[1..l] of integer;
const
zan:array [1..20] of trebro= ((1,3,1),
(1,6,2),
(2,3,3),
(3,2,3),
(3,4,2),
(3,7,1),
(4,2,1),
(5,4,2),
(6,1,3),
(6,5,3),
(7,1,2),
(8,4,1),
(8,6,1),
(8,8,2),
(9,5,3),
(9,9,3),
(9,11,2),
(10,8,1),
(10,10,1),
(10,12,2));
type TmaxUp=array[1..20] of integer;
var
a:integer;
Podgraph,par{so4etanie}:array [1..20] of trebro;
maxUP:tmaxup;
maxDown:tmaxup;
{************************************************* **************************}
procedure c4et(var maxUp:tmaxUp;nst,maxn:integer);{c4itaem verx}
var i,j,p:byte;
begin
for i:=1 to k do
maxUP[i]:=0;
for p:=1 to maxn do
for j:=1 to n do
begin
if zan[j,nst]=p then
begin
maxUP[p]:=maxUP[p]+zan[j,l];
end;
end;
end;
{************************************************* **************************}
function maxstepen (maxUp:tmaxup;maxn:integer):byte;
var pmax,i:integer;
begin
pmax:=MaxUp[1];
for i:=2 to maxn do
if MaxUp[i]>pmax then
begin
pmax:=maxup[i];
maxstepen:=i;
end;
end;
{************************************************* **************************}
procedure videlgraph(var k:integer;nmax,nst:integer);
var i:byte;
{k-kol-vo reber v pografe
nmax-nomer verIIIini c max stepen
nst-nomer stolbILa}
begin
k:=0;
for i:=1 to n do
if zan[i,nst]=nmax then
begin
inc(k);
podgraph[k]:=zan[i];
end;
end;
{************************************************* **************************}
procedure paroso4(var k:integer);
var up,down,minv:array [1..20] of byte;
pyti:array [1..20,0..20] of byte;
i,j,l,g,d,q,vv,vn,kp:byte;
flag, stop, theend: boolean;
begin
repeat
fillchar(up,sizeof(up),0);
fillchar(down,sizeof(down),0);
k:=0;
for i:=1 to 10 do
begin
if up[i]=0 then
for j:=1 to n do
if (zan[j,1]=i) and (down[zan[j,2]]=0) then
begin
up[i]:=1;
down[zan[j,2]]:=1;
inc(k);
par[k]:=zan[j];
break;
end;
end;
repeat
fillchar(pyti,sizeof(pyti),0);
fillchar(minv,sizeof(minv),0);
g:=1;
for i:=1 to 10 do
if up[i]=0 then
begin
inc(pyti[g,0]);
pyti[g,pyti[g,0]]:=i;
end;
repeat
theend:=false;
inc(g);
for i:=1 to pyti[g-1,0] do
begin
vv:=pyti[g-1,i];
for j:=1 to n do
if vv=zan[j,1] then
begin
q:=1;
while (q<=k) and ((zan[j,1]<>par[q,1]) or
(zan[j,2]<>par[q,2])) do inc(q);
if (q>k) then
if minv[zan[j,2]]=0 then
begin
minv[zan[j,2]]:=1;
inc(pyti[g,0]);
pyti[g,pyti[g,0]]:=zan[j,2];
{break;}
end;
end;
end;
flag:=false;
for q:=1 to pyti[g,0] do
if down[pyti[g,q]]=0 then
begin
flag:=true;
kp:=q;
end;
if (pyti[g,0]=0) then theend:=true;
if (pyti[g,0]>0) and not flag then
begin
inc(g);
for i:=1 to pyti[g-1,0] do
begin
vn:=pyti[g-1,i];
for j:=1 to k do
if vn=par[j,2] then
begin
inc(pyti[g,0]);
pyti[g,pyti[g,0]]:=par[j,1];
break;
end;
end;
end;
until flag or theend;

{vosstanovit' pyt'}
for i:=g-1 downto 1 do
begin
flag:=false;
for j:=1 to pyti[i,0] do
begin
for q:=1 to n do
if odd(i) then
if (pyti[i+1,kp]=zan[q,2]) and (pyti[i,j]=zan[q,1])
then begin flag:=true; break; end
else
else
if (pyti[i+1,kp]=zan[q,1]) and (pyti[i,j]=zan[q,2])
then begin flag:=true; break; end
else;
if flag then break;
end;
if odd(i) then
begin
inc(k);
par[k]:=zan[q];
down[par[k,2]]:=1;
up[par[k,1]]:=1;
end
else
begin
d:=1;
while not((zan[q,1]=par[d,1]) and (zan[q,2]=par[d,2])) do inc(d);
for q:=d to k-1 do
par[q]:=par[q+1];
fillchar(par[k],sizeof(par[k]),0);
dec(k);
end;
kp:=j;
end;
flag:=false;
for j:=1 to 12 do
if down[j]=0 then
flag:=true;
until theend or not flag;
for q:=1 to k-1 do
write(par[q,1]:3);
writeln;
for q:=1 to k-1 do
write(par[q,2]:3);
writeln;
for i:=1 to k-1 do
for j:=1 to n do
if (par[i,1]=zan[j,1]) and (par[i,2]=zan[j,2]) then
begin
dec(zan[j,3]);
if zan[j,3]=0 then
begin
for q:=j to n-1 do
zan[q]:=zan[q+1];
dec(n);
end;
end;
until n=0;
end;
{************************************************* **************************}
var i,kk:integer;
begin
clrscr;

{c4et(maxup,1,10);
c4et(maxdown,2,12);
videlgraph(a,maxstepen(maxup,10),1);
{videlgraph(a,maxstepen(maxdown,12),2);}
paroso4(kk);
readln;
for i:=1 to kk do
writeln(par[i,1],par[i,2]:4,par[i,3]:4)
end.




Вобщем, как я понял из общения с авторами этого произведения, данная задача не имеет конкретного решения и все расписания составляются практически руками, но для теории сойдёт ...

42d3e78f26a4b20d412==