Program goroda;
Var a: array [1..10,1..10] of real;     {матрица времени ожидания в пунктах назначения}
    f: text;                            {переменная файла из которого заполняем матрицу}
    k: integer;                         {храним количество вершин(пунктов отправления и пунктов назначения)}
    i,j: integer;
    x,y,z:integer;                      {X-множество рейсов из пунктов отправления,x,z из X,
                                        Y-множество рейсов из пунктов назначения,y из Y}
    metka: array [1..10] of integer;    {состоит из 0 и 1, 0-вершина не помечена, 1-вершина помечена}
    t: array [1..10] of integer;        {множество свободных вершин относительно текущего паросочетния}
    xpara: array [1..10] of integer;    {в xpara храним пары к x, в ypara храним пары к y}
    ypara: array [1..10] of integer;
    x0,v: integer;                      {из вершины х0 начинаем поиск паросочетаний}
    tt,prisnak:integer;                 {признак используем как условие выхода из цикла}
    stek: array [1..10] of integer;     {храним вершины текущего паросочетания}
    st1,st2: integer;
    xx: array [1..10] of integer;       {массив строк}
    yy: array [1..10] of integer;       {массив столбцов}


Procedure vvod;
Begin
    {заполняем массив данными из файла и выводим его на экран}
    assign(f,'in1.txt');
    reset(f);
    read(f,k); {число вершин}
    for i:=1 to k do
    begin
      write(i:3);
      for j:=1 to k do
      begin
        read(f,a[i,j]);
        write(a[i,j]:5:1);
      end;
      writeln;
    end;
    close(f);
End;

Procedure min;  {поиск минимального значения в строках и столбцах}
Var minx, miny: real; {переменные для минимальных значений}
Begin
   for i:=1 to k do   {находим минимальное значение в одной строке,по умолчанию до начала цикла равно 32000}
   begin
     minx:=32000;
     for j:=1 to k do
       if a[i,j]<minx then minx:=a[i,j];
     for j:=1 to k do
       a[i,j]:=a[i,j]-minx; {вычитаем это значение из всех элементов строки}
   end;

   for j:=1 to k do   {аналогично для столбцов}
   begin
     miny:=32000;
     for i:=1 to k do
       if a[i,j]<miny then miny:=a[i,j];
     for i:=1 to k do
       a[i,j]:=a[i,j]-miny;
   end;
End;

Procedure printa;   {вывод преобразованной матрицы на экран}
Begin
   for i:=1 to k do
   begin
     write(i:3);
     for j:=1 to k do
       write(a[i,j]:5:1);
     writeln;
   end;
End;

Procedure start; {начинаем поиск паросочетаний}
Begin
  x0:=1; {ищем из превой вершины}
  while ((t[x0]=0)and(x0<=k)) do x0:=x0+1; {если t еще не рассматривалось
        и х0 не превышает количества вершин, то переходим к следующей вершине}
  if x0>k then x0:=0;  {если х0 превысило количество вершин, обнуляем}
End;

Procedure vubor; {подбираем y для х, находим обну пару}
Var q:integer;
Begin
  v:=1;  {начинаем поиск y с первого}
  q:=x;
  while ((v<=k)and((metka[v]=1)or(a[q,v]<>0))) do {пока(y не превысило количества вершин)
        и пока(не нашли непомеченную вершину или элемент не равный 0)}
    v:=v+1; {переходим к следующему y}
  if v>k then v:=0  {если количество y превысило количество вершин, обнуляем}
         else metka[v]:=1; {иначе помечаем вершину единицей}
  y:=v;  {находим y}
End;

Procedure kun;  {алгоритм Куна, нахождение паросочетаний}
begin
  tt:=k;
  For i:=1 to k do  {изначально множество паросочетаний пусто}
  begin
    t[i]:=1;
    xpara[i]:=0;
    ypara[i]:=0;
  end;

  repeat start;     {начинаем поиск}
    for i:=1 to k do metka[i]:=0; {изначально ни один элемент не помечен}
    st1:=1;          st2:=1;      {ссылки на stek}
    stek[st2]:=x0;   st2:=st2+1;
    prisnak:=0;
    while ((st2-st1<>0)and(prisnak=0)) do
    begin
      x:=stek[st2-1];
      vubor; {y:=vubor}
      if y<>0 then
      begin
        stek[st2]:=y;
        st2:=st2+1;
        z:=ypara[y];
        if z<>0 then
        begin
          stek[st2]:=z;
          st2:=st2+1;
        end
        else prisnak:=1;
      end
      else
      begin
        st1:=st1+1;
        if (st2-st1>0) then st1:=st1+1;
      end;
    end;
    for i:=1 to k do
    begin
       xx[i]:=0;
       yy[i]:=0;
    end;
{    i:=1;
    while i<st2 do
    begin
        x:=stek[i];     i:=i+1;
        y:=stek[i];     i:=i+1;
        xx[x]:=1;
        yy[y]:=1;
    end;
    for i:=1 to k do writeln('в стеке',stek[i]);}
    if prisnak=1 then
      while st2-st1>0 do
      begin
        x:=stek[st1];     st1:=st1+1;
        y:=stek[st1];     st1:=st1+1;
        t[x0]:=0;
        xpara[x]:=y;
        ypara[y]:=x;
      end;
    tt:=0;
    for i:=1 to k do
      if t[i]=1 then tt:=tt+1;

  until ((prisnak=0)or(tt=0));


  if prisnak=0 then writeln('нет полного паросочетания надо улучшать матрицу')
               else
               begin
                 writeln('нашли полное паросочетание');
                 for i:=1 to k do writeln(i:2,xpara[i]:3);
               end;
end;

Procedure verch;
Begin
   i:=1;
    while i<st2 do
    begin
        x:=stek[i];     i:=i+1;
        y:=stek[i];     i:=i+1;
        xx[x]:=1;
        yy[y]:=1;
    end;
{    for i:=1 to st2-1 do writeln('в стеке',stek[i]);}
end;


Procedure ddd;
var min,mix:real;
begin
  min:=32000;
  for i:=1 to k do
  begin
    if xx[i]=1 then
    begin
      for j:=1 to k do
        if ((yy[j]=0)and(a[i,j]<min)) then min:=a[i,j];
    end;
  end;

  for i:=1 to k do
  begin
    if xx[i]=1 then
    begin
      for j:=1 to k do
        if yy[j]=0 then a[i,j]:=a[i,j]-min;
    end;
  end;

  for i:=1 to k do
  begin
    if xx[i]=0 then
    begin
      for j:=1 to k do
        if yy[j]=1 then a[i,j]:=a[i,j]+min;
    end;
  end;


end;

Begin
  vvod;
  writeln('наша исходная матрица');
  readln;
  min;
  printa;
  writeln('получили первые нули');
  readln;
 { start; {выбор начальной вершины x0}
 { vubor; {выбор вершины v}
 prisnak:=0;
 while prisnak=0 do
 begin
   kun;
   if prisnak=0 then
   begin
     verch;
     ddd;
     printa;
     readln
   end;
 end;
 writeln('вот и конец программы');
 readln;
End.