ASSIGN1 - Phân công hoàn thành sớm nhất

Tác giả: khuc_tuan

Ngôn ngữ: Pascal

Uses math;
Const     inp = '';
          out = '';
          maxn = 1001;

Var       n,res,c    : longint;
          a    : array [1..maxn,1..maxn] of longint;
          mx,my,queue,trace  :     array [1..maxn] of longint;

procedure nhap;
var i,j : longint;
  begin
      assign(input,inp); reset(input);
      assign(output,out); rewrite(output);
      readln(n);
      for i := 1 to n do
        for j := 1 to n do
          begin
            read(a[i,j]);
            c := max(c,a[i,j]);
          end;
  end;

procedure khoitao(x : longint);
var i,j : longint;
  begin
      fillchar(mx,sizeof(mx),0);
      fillchar(my,sizeof(my),0);
      for i := 1 to n do
        for j := 1 to n do
          if (a[i,j]<=x) and (my[j]=0) then
            begin
                my[j] := i; mx[i] := j;
                break;
            end;
  end;

function timduongmo(x : longint) : longint;
var i,j,left,right : longint;
   begin
       fillchar(trace,sizeof(trace),0);
       left := 0; right := 0;
       for i := 1 to n do
         if mx[i]=0 then
           begin
               inc(right); queue[right] := i;
           end;
       while left < right do
         begin
             inc(left); i := queue[left];
             for j := 1 to n do
               if (a[i,j]<=x) and (trace[j]=0) then
                 begin
                     trace[j] := i;
                     if my[j]=0 then exit(j);
                     inc(right); queue[right] := my[j];
                 end;
         end;
       exit(0);
   end;

procedure morong(f : longint);
var next,x : longint;
  begin
      repeat
         x := trace[f];
         next := mx[x];
         mx[x] := f;
         my[f] := x;
         f := next;
      until f=0;
  end;

function check(x : longint) : boolean;
var i,j,f,dem : longint;
  begin
      khoitao(x);
      repeat
         f := timduongmo(x);
         if f = 0 then break;
         morong(f);
      until false;
      dem := 0;
      for i := 1 to n do
        if mx[i]<>0 then inc(dem);
      if dem=n then exit(true) else exit(false);
  end;

procedure main;
var d,mid : longint;
  begin
      d := 0;
      while d <= c do
        begin
          mid := (d+c) shr 1;
          if check(mid) then
            begin
                res := mid;
                c := mid-1;
            end
          else d := mid+1;
        end;
      writeln(res);
  end;

begin
    nhap;
    main;
end.

Download