Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.01.2010, 00:36   #1
matsa
 
Регистрация: 24.10.2009
Сообщений: 5
По умолчанию как работает прогамма?

добрый вечер!
как работает программа? шо вписывать во входной файл "in" и что должно вывести с "out" файла?


программу скачал из инета автор написал: Венгерский алгоритм построения оптимального паросочетания (один тест не проходит, не помню в чем проблема, но очень легко исправить)

Код:
 nn=60;

var a,b:array[1..nn,1..nn] of integer;
    prev,markx,marky,xdouble,ydouble:array[1..nn] of integer;
    mx,my,mcx,mcy,ysub,xsub,t:array[0..nn] of integer;
    s,bzero:array[1..nn,0..nn] of integer;
    i,j,k,x,y,z,ind,n,m,x0,result:integer;
    f:text;

procedure sub;
var i,j:integer;t:boolean;
begin
   ysub[0]:=0;
   for i:=1 to my[0] do
   begin
      t:=true;
      for j:=1 to mcy[0] do
      if (my=mcy[j]) then begin t:=false;break;end;
      if (t=true) then begin ysub[ysub[0]+1]:=my;inc(ysub[0]);end;
   end;
end;

procedure sub1;
var i,j:integer;t:boolean;
begin
   xsub[0]:=0;
   for i:=1 to mx[0] do
   begin
      t:=true;
      for j:=1 to mcx[0] do
      if (mx=mcx[j]) then begin t:=false;break;end;
      if (t=true) then begin xsub[xsub[0]+1]:=mx;inc(xsub[0]);end;
   end;
end;

procedure transform;
var i,j,min:integer;
begin
   for i:=1 to n do
   begin
      min:=30000;
      for j:=1 to n do
      if (b[i,j]<min) then min:=b[i,j];
      if (min>0) then
      for j:=1 to n do
      b[i,j]:=b[i,j]-min;
   end;

   for i:=1 to n do
   begin
      min:=30000;
      for j:=1 to n do
      if (b[j,i]<min) then min:=b[j,i];
      if (min>0) then
      for j:=1 to n do
      b[j,i]:=b[j,i]-min;
   end;
end;

procedure operation;
var i,j,min:integer;
begin
   sub;
   min:=30000;
   for i:=1 to mcx[0] do
   for j:=1 to ysub[0] do
   if (b[mcx,ysub[j]]<min) then min:=b[mcx,ysub[j]];

   for i:=1 to mcx[0] do
   begin
      for j:=1 to ysub[0] do
      b[mcx,ysub[j]]:=b[mcx,ysub[j]]-min;
   end;
   sub1;
   for i:=1 to xsub[0] do
   begin
      for j:=1 to mcy[0] do
      b[xsub,mcy[j]]:=b[xsub,mcy[j]]+min;
   end;
end;

function start:integer;
begin
   start:=t[t[0]];dec(t[0]);
end;

procedure search(x:integer);
begin
   while ((s[x,0]<>0)and(ind=0)) do
   begin
      y:=s[x,s[x,0]];dec(s[x,0]);
      if (marky[y]=0) then
      begin
         marky[y]:=1;prev[y]:=x; mcy[mcy[0]+1]:=y;inc(mcy[0]);
         z:=ydouble[y];
         if (z<>0) then
         begin
            markx[z]:=1;prev[z]:=y; mcx[mcx[0]+1]:=z;inc(mcx[0]);
            search(z);
         end
         else ind:=1;
      end;
   end;
end;

begin
   assign(f,'in.txt');
   reset(f);
   readln(f,m,n);
   for i:=1 to m do
   begin
      for j:=1 to n do
      read(f,a[i,j]);
      mx:=i;{my[j]:=j;}
      readln(f);
   end;
   close(f);mx[0]:=n;my[0]:=n;{my:=mx;}
   for i:=m+1 to n do
   begin
      for j:=1 to n do
      a[i,j]:=30000;
      mx:=i;
   end;my:=mx;

   b:=a;transform;
   for i:=1 to mx[0] do bzero[mx,0]:=0;
   for i:=1 to mx[0] do
   for j:=1 to my[0] do
      if b[mx,my[j]]=0 then begin bzero[mx,bzero[mx,0]+1]:=my[j];inc(bzero[mx,0]);end;
   for i:=1 to mx[0] do
   begin
      x0:=mx;
      for j:=1 to my[0] do marky[my[j]]:=0;
      for k:=1 to mx[0] do
      begin
         markx[mx[k]]:=0;s[mx[k]]:=bzero[mx[k]];
      end;
      markx[x0]:=1;mcx[1]:=x0;mcx[0]:=1;mcy[0]:=0;
      ind:=0;search(x0);
      if ind=0 then
      repeat
         operation;t[0]:=0;
         for k:=1 to mcx[0] do
         begin
         sub;
         for j:=1 to ysub[0] do
            if b[mcx[k],ysub[j]]=0 then
            begin
               bzero[mcx[k],bzero[mcx[k],0]+1]:=ysub[j];inc(bzero[mcx[k],0]); s[mcx[k],s[mcx[k],0]+1]:=ysub[j];
               inc(s[mcx[k],0]);t[t[0]+1]:=mcx[k];inc(t[0]);
            end;
         end;
         while (t[0]<>0)and(ind=0) do
         begin
            x:=start;search(x);
         end;
      until ind=1;
      x:=prev[y];xdouble
:=y;ydouble[y]:=x;
     while x<>x0 do
      begin
         y:=prev
;x:=prev[y];
        xdouble
:=y;ydouble[y]:=x;
     end;
   end;

   result:=0;
   for i:=1 to n do
   result:=result+a[i,xdouble];
   assign(f,'out.txt');
   rewrite(f);
   write(f,result);
   close(f);
end.

вот это граф которые имеет парные вершины. программа должна найти сколько здесь является четных вышек(по-украински "вершин"). эта программа подойдет? как ее переделать?
задавать надо в виде матрицы:

если есть пара тогда 1, если нет то 0.

1 2 3 4 5

1 0 1 0 0 1
2 1 0 1 0 0
3 0 1 0 1 0
4 0 0 1 0 1
5 1 0 0 1 0


Последний раз редактировалось Stilet; 22.01.2010 в 12:16.
matsa вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
как работает ноды? NurNet Общие вопросы Delphi 1 21.08.2009 08:15
Си++. Как это работает? paladinn Помощь студентам 3 18.07.2009 01:48
Как работает?! KamBall Общие вопросы C/C++ 2 01.06.2009 19:23
Прогамма для проведения автогонок mancubus Фриланс 16 15.05.2009 13:18
прогамма для роботы с сетью blackstersl Работа с сетью в Delphi 4 23.01.2009 16:36