SPFA with edmond karp is enough. AC 0.06 (test might be weak) Can somebody send me a good algo of min cost max matching? I've found a solution, but it runs in O(n^4), so I get time limit exceeded for some tests. > I've used a Hungarian algo that I've found on the NET. I don't know if it's correct because, for some tests it cycles to the infinite because no modifications can be done. Please, could somebody give me an algo that works? Here's my source. Usually it works fine but, as I said, in some cases it doesn't work. program trash; const nmax = 150; var a, d : array [1..nmax, 1..nmax] of integer; s : array [1..nmax] of integer; nz : array [1..nmax] of byte; m, b : array [1..nmax, 1..nmax] of boolean; hasm, found : boolean; mlin, mcol : array [1..nmax] of boolean; ming1 : integer; sum : longint; N, i, j : byte; procedure readdata; begin { assign(input, 'trash.in'); reset(input);} fillchar(s, sizeof(s), 0); readln(N); for i:=1 to N do begin for j:=1 to N do begin read(d[i,j]); inc(s[i], d[i,j]); end; for j:=1 to N do begin a[i,j]:=s[i]-d[i,j]; d[i,j]:=a[i,j]; end; readln; end; { close(input);} end; procedure DoZero; var i, j : byte; min : integer; begin for i:=1 to N do begin min:=a[i,1]; for j:=2 to N do if a[i,j]<min then min:=a[i,j]; for j:=1 to N do dec(a[i,j], min); end; for j:=1 to N do begin min:=a[1,j]; for i:=2 to N do if a[i,j]<min then min:=a[i,j]; for i:=1 to N do dec(a[i,j],min); end; end; function DoMark:boolean; var i, j, k, min, r : byte; begin fillchar(nz, sizeof(nz), 0); fillchar(m, sizeof(m), 0); fillchar(b, sizeof(b), 0); for i:=1 to N do for j:=1 to N do if a[i,j]=0 then inc(nz[i]); for k:=1 to N do begin {choose a row with min 0's} min:=255; for i:=1 to N do if (nz[i]>0)and(nz[i]<min) then begin min:=nz[i]; r:=i; end; if min=255 then begin DoMark:=false; exit; end; j:=1; nz[r]:=0; while (a[r,j]<>0)or(b[r,j]) do inc(j); m[r,j]:=true; {is marked} for i:=j+1 to N do if (a[r,i]=0) then b[r,i]:=true; for i:=1 to N do if (i<>r)and(a[i,j]=0) then begin b[i,j]:=true; dec(nz[i]); end; end; DoMark:=true; end; begin readdata; DoZero; while not DoMark do begin fillchar(mlin, sizeof(mlin), false); fillchar(mcol, sizeof(mcol), false); for i:=1 to N do begin hasm:=false; for j:=1 to N do if m[i,j] then begin hasm:=true; break; end; if not hasm then mlin[i]:=true; end; repeat found:=false; for i:=1 to N do if mlin[i] then for j:=1 to N do if (b[i,j])and(mcol[j]=false) then begin mcol[j]:=true; found:=true; end; if found then for j:=1 to N do if mcol[j] then for i:=1 to N do if (m[i,j])and(not mlin[i]) then begin mlin[i]:=true; found:=true; end; until not found; {i've made the marking} ming1:=maxint; for i:=1 to N do for j:=1 to N do if (mlin[i])and(not mcol[j])and(a[i,j]<ming1) then ming1:=a[i,j]; for i:=1 to N do for j:=1 to N do if (mlin[i])and(not mcol[j]) then dec(a[i,j], ming1); for i:=1 to N do for j:=1 to N do if (not mlin[i])and(mcol[j]) then inc(a[i,j], ming1); end; sum:=0; for i:=1 to N do for j:=1 to N do if m[i,j] then inc(sum, d[i,j]); writeln(sum); end. But how? Its complexity is O(n^4). I got TLE. Please, someone, tell me how to do it. no text Edited by author 12.12.2007 00:40 Usual mincost maxflow got easily AC here. I used maxflow with dijkstra to path searching. Dijkstra works O(n^2) ant increases flow by 1 eachtime. So we need only O(n) dijkstras to reach maxflow. Whole complexivity is O(n^3). In c++ is works for 0.171sec. How can you use Dijkstra since there are some edges which have minus values(values <0)? I used Bellman-Ford algo, and it doesn't run out of time. Use Dejkstra with potenciales. Modify weigth of eadges ... It's standart algorithm. I use SPFA but my problem got TLE with TEST#4 Testing machine is so fast now that an O(N^4) algo gets AC in less than 0.5s. Hungarian: 15ms Min cost flow with Dijkstra: 171 ms Min cost flow with optimized Bellman-Ford: 109 ms ¯\_(ツ)_/¯ What? How can min-cost flow with Dijkstra be used if negative edge exists (in residual graph)? Edit: Is it used with Johnson's potential. Edited by author 14.01.2025 10:15 program djy; var a:array[1..150,1..150] of integer; lx,ly,link:array[1..150] of integer; flagx,flagy:array[1..150] of boolean; n:longint; procedure init; var i,j:longint; begin readln(n); for i:=1 to n do for j:=1 to n do read(a[i,j]); end; procedure prepare; var i,j,s:longint; begin {for i:=1 to n do begin s:=0; for j:=1 to n do s:=s+a[j,i]; for j:=1 to n do a[j,i]:=a[j,i]-s; end;} fillchar(lx,sizeof(lx),0); fillchar(ly,sizeof(ly),0); for i:=1 to n do for j:=1 to n do if a[i,j]>lx[i] then lx[i]:=a[i,j]; end; function find(i:longint):boolean; var j:longint; begin flagx[i]:=true; for j:=1 to n do if (lx[i]+ly[j]=a[i,j]) and (flagy[j]=false) then begin flagy[j]:=true; if (link[j]=0) or (find(link[j])=true) then begin link[j]:=i; find:=true; exit; end; end; find:=false; end; procedure main; var i,j,k,d:longint; begin fillchar(link,sizeof(link),0); for k:=1 to n do repeat fillchar(flagx,sizeof(flagx),false); fillchar(flagy,sizeof(flagy),false); if find(k)=true then break; d:=maxint; for i:=1 to n do for j:=1 to n do if (flagx[i]=true) and (flagy[j]=false) and (lx[i]+ly[j]-a[i,j]<d) then d:=lx[i]+ly[j]-a[i,j]; for i:=1 to n do if flagx[i]=true then lx[i]:=lx[i]-d; for i:=1 to n do if flagy[j]=true then ly[j]:=ly[j]+d; until false; end; procedure print; var i,j,s:longint; begin s:=0; for i:=1 to n do for j:=1 to n do s:=s+a[i,j]; for i:=1 to n do s:=s-a[link[i],i]; writeln(s); end; begin init; prepare; main; print; end. You gotta use A+B code. I don't remember the correct algorithm but you can find'em in the tutorial. I got AC. Seriously. а что на русском темы писать нельзя и задачи Потому что вы безграмотно на нём пишете. I constantly get Wrong Answer on test 32. Does anybody know what the test is (and if yes, can I get it somehow?). I wrote a Hungarian Algorithm, but i probably have a mistake somewhere =/ Edit: Nevermind that, I got Accepted =) Edited by author 12.01.2008 06:03 the N is bigger than 150. Smth like 150 1 2 3 4 .. 2 4 6 8 .. 3 6 9 12 .. 4 8 12 16 .. ............ Some solutions, which use Min Cost Flow to solve this problem can be failed (for example, my last submition). Your test is not correct because all numbers must be from 0 to 100. But the tests in this problem are really weak. You can generate new hard tests and send them to me (sandro sobaka plotinka ru) or Vladimir Yakovlev. I've used an Hungarian algo I've found on the NET. I don't know if it's correct because, for some tests it cycles to the infinite because no modifications can be done. Please, could somebody give me an algo that works? Here's my source. Usually it works fine but, as I said, in some cases it doesn't work. program trash; const nmax = 150; var a, d : array [1..nmax, 1..nmax] of integer; s : array [1..nmax] of integer; nz : array [1..nmax] of byte; m, b : array [1..nmax, 1..nmax] of boolean; hasm, found : boolean; mlin, mcol : array [1..nmax] of boolean; ming1 : integer; sum : longint; N, i, j : byte; procedure readdata; begin { assign(input, 'trash.in'); reset(input);} fillchar(s, sizeof(s), 0); readln(N); for i:=1 to N do begin for j:=1 to N do begin read(d[i,j]); inc(s[i], d[i,j]); end; for j:=1 to N do begin a[i,j]:=s[i]-d[i,j]; d[i,j]:=a[i,j]; end; readln; end; { close(input);} end; procedure DoZero; var i, j : byte; min : integer; begin for i:=1 to N do begin min:=a[i,1]; for j:=2 to N do if a[i,j]<min then min:=a[i,j]; for j:=1 to N do dec(a[i,j], min); end; for j:=1 to N do begin min:=a[1,j]; for i:=2 to N do if a[i,j]<min then min:=a[i,j]; for i:=1 to N do dec(a[i,j],min); end; end; function DoMark:boolean; var i, j, k, min, r : byte; begin fillchar(nz, sizeof(nz), 0); fillchar(m, sizeof(m), 0); fillchar(b, sizeof(b), 0); for i:=1 to N do for j:=1 to N do if a[i,j]=0 then inc(nz[i]); for k:=1 to N do begin {choose a row with min 0's} min:=255; for i:=1 to N do if (nz[i]>0)and(nz[i]<min) then begin min:=nz[i]; r:=i; end; if min=255 then begin DoMark:=false; exit; end; j:=1; nz[r]:=0; while (a[r,j]<>0)or(b[r,j]) do inc(j); m[r,j]:=true; {is marked} for i:=j+1 to N do if (a[r,i]=0) then b[r,i]:=true; for i:=1 to N do if (i<>r)and(a[i,j]=0) then begin b[i,j]:=true; dec(nz[i]); end; end; DoMark:=true; end; begin readdata; DoZero; while not DoMark do begin fillchar(mlin, sizeof(mlin), false); fillchar(mcol, sizeof(mcol), false); for i:=1 to N do begin hasm:=false; for j:=1 to N do if m[i,j] then begin hasm:=true; break; end; if not hasm then mlin[i]:=true; end; repeat found:=false; for i:=1 to N do if mlin[i] then for j:=1 to N do if (b[i,j])and(mcol[j]=false) then begin mcol[j]:=true; found:=true; end; if found then for j:=1 to N do if mcol[j] then for i:=1 to N do if (m[i,j])and(not mlin[i]) then begin mlin[i]:=true; found:=true; end; until not found; {i've made the marking} ming1:=maxint; for i:=1 to N do for j:=1 to N do if (mlin[i])and(not mcol[j])and(a[i,j]<ming1) then ming1:=a[i,j]; for i:=1 to N do for j:=1 to N do if (mlin[i])and(not mcol[j]) then dec(a[i,j], ming1); for i:=1 to N do for j:=1 to N do if (not mlin[i])and(mcol[j]) then inc(a[i,j], ming1); end; sum:=0; for i:=1 to N do for j:=1 to N do if m[i,j] then inc(sum, d[i,j]); writeln(sum); end. In hungarian algorithm we've got to implement max match for a bipartite graph. What methods are quite enough to got AC? I impelemented recursive argumental chains and got TL#6. What about non-recursive chains? program ural1076; const maxn=150; var w:array[1..maxn,1..maxn]of byte; g:array[1..maxn,1..maxn]of shortint; {0:not in the equal sub-graph; 1:unmatched; -1:matched} lx,ly:array[1..maxn]of byte; s,t,cx,cy:set of 1..maxn; n,i,j:byte; total:longint; function path(x:byte):boolean; var i,j:byte; begin path:=false; for i:=1 to n do if not (i in t) and (g[x,i]<>0) then begin t:=t+[i]; if not (i in cy) then begin g[x,i]:=-g[x,i]; cy:=cy+[i]; path:=true; exit; end; j:=1; while (j<=n) and not (j in s) and (g[j,i]>=0) do inc(j); if j<=n then begin s:=s+[j]; if path(j) then begin g[x,i]:=-g[x,i];g[j,i]:=-g[j,i]; path:=true; exit; end; end; end; end; procedure KM; var root,i,j,al:byte; begin fillchar(lx,sizeof(lx),0); fillchar(ly,sizeof(ly),0); for i:=1 to n do for j:=1 to n do if w[i,j]>lx[i] then lx[i]:=w[i,j]; for i:=1 to n do for j:=1 to n do if lx[i]+ly[j]=w[i,j] then g[i,j]:=1 else g[i,j]:=0; root:=1;cx:=[];cy:=[]; while root<=n do begin s:=[root];t:=[]; if not (root in cx) then begin if path(root) then cx:=cx+[root] else begin al:=255; for i:=1 to n do for j:=1 to n do if (i in s) and not (j in t) then if lx[i]+ly[j]-w[i,j]<al then al:=lx[i]+ly[j]-w[i,j]; for i:=1 to n do if i in s then dec(lx[i],al); for i:=1 to n do if i in t then inc(ly[i],al); for i:=1 to n do for j:=1 to n do if lx[i]+ly[j]=w[i,j] then g[i,j]:=1 else g[i,j]:=0; cx:=[];cy:=[]; end; root:=0; end; inc(root); end; end; begin readln(n); for i:=1 to n do for j:=1 to n do read(w[i,j]); KM; total:=0; for i:=1 to n do for j:=1 to n do if g[i,j]>=0 then inc(total,w[i,j]); writeln(total); end. My solution here: const max=160; var g:array[1..max,1..max] of integer; x,y:array[1..max] of boolean; link,lx,ly:array[1..max] of longint; n,num:longint; procedure readdata; var i,j:integer; begin readln(n); for i:=1 to n do begin for j:=1 to n-1 do read(g[i,j]); readln(g[i,n]); end; end; function find(i:integer):boolean; var k,p:integer; begin find:=true; x[i]:=true; for k:=1 to n do if not y[k] and (lx[i]+ly[k]=g[i,k]) then begin p:=link[k];link[k]:=i;y[k]:=true; if (p=0) or find(p) then exit; link[k]:=p; end; find:=false; end; procedure main; var i,j,d:integer; begin for i:=1 to n do for j:=1 to n do if g[i,j]>lx[i] then lx[i]:=g[i,j]; for i:=1 to n do repeat fillchar(x,sizeof(x),0);fillchar(y,sizeof(y),0); if find(i) then break; for i:=1 to n do if x[i] then for j:=1 to n do if not y[j] then if lx[i]+ly[j]-g[i,j]<d then d:=lx[i]+ly[j]-g[i,j]; for i:=1 to n do if x[i] then lx[i]:=lx[i]-d; for j:=1 to n do if y[j] then ly[j]:=ly[j]+d; until false; end; function did(a,b:integer):boolean; var k:integer; m:longint; begin k:=a;did:=false;m:=a; while k>1 do begin dec(k);m:=m*k; if m>b then exit; end; if m=b then did:=true; end; procedure print; var i,j:integer; begin for i:=1 to n do for j:=1 to n do if link[j]=i then else begin if (i>=link[j])or(i>=6) then num:=num+g[i,j] else if did(i,link[j]) then else num:=num+g[i,j]; end; writeln(num); end; BEGIN readdata; main; print; END. Who have a AC program ? Sent to wlwy2003@hotmail.com ,OK? Do you know where this algoritm can be found? (books, web peges?) or you can make me understand it ? Please email me ! (if you want to know smth that i do i will explain you too) (tzi_ganci@hotmail.com) Thanks! > > Do you know where this algoritm can be found? (books, web peges?) or > you can make me understand it ? > Please email me ! (if you want to know smth that i do i will explain > you too) > (tzi_ganci@hotmail.com) > Thanks! Give me your email adress or mail-me, please!
> > Give me your email adress or mail-me, please! > {$R+} const MAXN = 155; var d,a:array[1..MAXN,1..MAXN]of longint; { x:array[1..150,1..150]of byte;} { p,q:array[1..150]of byte;} c:array[1..2*MAXN]of longint; use:array[1..2*maxn]of longint; b:array[1..2*MAXN,1..2*MAXN]of longint; exp:array[1..MAXN]of longint; { u,v:array[1..150]of byte;} { r:array[1..150,1..150]of byte;} { su:array[1..150]of integer;} s:array[1..MAXN]of longint; N,h,i,j,delta:longint; procedure out; var ans,c,_i,_j:longint; begin ans:=0; for i:=1 to 2*N do begin _i:=i;_j:=exp[i]; if i>exp[i] then begin c:=_i;_i:=_j;_j:=c; end; ans:=ans+d[_i,_j-N]; end; writeln(ans div 2); halt; end; procedure para; var s1,s2:array[1..1000]of longint; h1,h2,k,l,i,j:longint; aug:boolean; begin fillchar(use,sizeof(use),0); for i:=1 to N do for j:=1 to N do if a[i,j] = 0 then begin b[j+N,i]:=1; b[i,j+N]:=1; end; for i:=1 to N do for j:=N+1 to 2*N do if (b[i,j]=1)and(exp[i]=0)and(exp[j]=0) then begin exp[i]:=j;exp[j]:=i; end; for k:=1 to N do if exp[k] = 0 then begin fillchar(use,sizeof(use),0); h1:=1;s1[1]:=k;aug:=false;h:=0;use[k]:=1; while true do begin h2:=0; for i:=1 to h1 do begin for j:=N+1 to 2*N do if (b[s1[i],j]=1)and(exp[s1[i]]<>j)and(use [j] = 0) then begin c[j]:=s1[i];use[j]:=1; if exp[j] = 0 then begin l:=j;h:=0; while l<>0 do begin inc(h); s[h]:=l; l:=c[l]; end; for i:=1 to h do if i mod 2=1 then begin exp[s[i]]:=s[i+1]; exp[s[i+1]]:=s[i]; end; aug:=true; if aug then break; end; inc(h2); s2[h2]:=exp[j]; use[exp[j]]:=1; c[exp[j]]:=j; end; if aug then break; end; for i:=1 to h2 do s1[i]:=s2[i]; h1:=h2; if h1 = 0 then break; if aug then break; end; { break;} end; for i:=1 to N do if exp[i] = 0 then begin break; end; if exp[i]<>0 then out; end; begin { assign(input,'1076.dat');reset(input);} readln(N); for i:=1 to N do for j:=1 to N do begin read(d[i,j]); s[j]:=s[j]+d[i,j]; end; for i:=1 to N do for j:=1 to N do begin d[i,j]:=s[j]-d[i,j]; a[i,j]:=d[i,j]; end; for i:=1 to N do s[i]:=MaxInt; for i:=1 to N do for j:=1 to N do if a[i,j]<s[i] then s[i]:=a[i,j]; for i:=1 to N do for j:=1 to N do a[i,j]:=a[i,j]-s[i]; for j:=1 to N do s[i]:=MaxInt; for i:=1 to N do for j:=1 to N do if a[i,j]<s[j] then s[j]:=a[i,j]; for i:=1 to N do for j:=1 to N do a[i,j]:=a[i,j]-s[j]; while true do begin para; delta:=MaxInt; for i:=1 to N do if use[i]<>0 then for j:=N+1 to 2*N do if use[j]=0 then if delta>a[i,j-N] then begin delta:=a[i,j-N]; end; for i:=1 to N do if use[i]<>0 then for j:=N+1 to 2*N do if use[j]=0 then begin a[i,j-N]:=a[i,j-N]-delta; end; for i:=1 to N do if use[i]=0 then for j:=N+1 to 2*N do if use[i]<>0 then begin a[i,j-N]:=a[i,j-N]+delta; end; end; end. !!!! For "i" > for i:=1 to h1 do > begin > for j:=N+1 to 2*N do if (b[s1[i],j]=1)and(exp[s1[i]]<>j)and (use > [j] = 0) then > begin > c[j]:=s1[i];use[j]:=1; > if exp[j] = 0 then > begin > l:=j;h:=0; > while l<>0 do > begin > inc(h); > s[h]:=l; > l:=c[l]; > end; !!!! And now FOR "i" > for i:=1 to h do if i mod 2=1 then > begin > exp[s[i]]:=s[i+1]; > exp[s[i+1]]:=s[i]; > end; > aug:=true; > if aug then break; > end; > inc(h2); > s2[h2]:=exp[j]; > use[exp[j]]:=1; > c[exp[j]]:=j; > end; > if aug then break; > end; > for i:=1 to h2 do s1[i]:=s2[i]; > h1:=h2; > if h1 = 0 then break; > if aug then break; > end; > { break;} > end; > for i:=1 to N do if exp[i] = 0 then > begin > break; > end; > if exp[i]<>0 then out; > end; > > begin > { assign(input,'1076.dat');reset(input);} > readln(N); > for i:=1 to N do > for j:=1 to N do > begin > read(d[i,j]); > s[j]:=s[j]+d[i,j]; > end; > for i:=1 to N do > for j:=1 to N do > begin > d[i,j]:=s[j]-d[i,j]; > a[i,j]:=d[i,j]; > end; > for i:=1 to N do s[i]:=MaxInt; > for i:=1 to N do > for j:=1 to N do if a[i,j]<s[i] then s[i]:=a[i,j]; > for i:=1 to N do > for j:=1 to N do a[i,j]:=a[i,j]-s[i]; > > for j:=1 to N do s[i]:=MaxInt; > for i:=1 to N do > for j:=1 to N do if a[i,j]<s[j] then s[j]:=a[i,j]; > for i:=1 to N do > for j:=1 to N do a[i,j]:=a[i,j]-s[j]; > > while true do > begin > para; > delta:=MaxInt; > for i:=1 to N do if use[i]<>0 then > for j:=N+1 to 2*N do if use[j]=0 then if delta>a[i,j-N] then > begin > delta:=a[i,j-N]; > end; > for i:=1 to N do if use[i]<>0 then > for j:=N+1 to 2*N do if use[j]=0 then > begin > a[i,j-N]:=a[i,j-N]-delta; > end; > for i:=1 to N do if use[i]=0 then > for j:=N+1 to 2*N do if use[i]<>0 then > begin > a[i,j-N]:=a[i,j-N]+delta; > end; > end; > > end. #include <stdio.h> int i,j,n,m,k; int gasit; int din[2][155]; long int v[155][155]; int fl[155][155]; void readdata() { FILE *f=stdin; fscanf(f,"%d",&n); for (i=1;i<=n;i++) for (j=1;j<=n;j++) fscanf(f,"%d",&v[i][j]); for (j=1;j<=n;j++) { long int tot=0; for (i=1;i<=n;i++) tot+=v[i][j]; for (i=1;i<=n;i++) v[i][j]=tot-v[i][j]; } for (i=1;i<=n;i++) fl[i][0]=1,fl[n+1][i]=1; fclose (f); } void findpath() { long int d[2][155]; int s[2][155]; for (i=0;i<=n+2;i++) d[0][i]=1000000000,d[1][i]=1000000000,din[0][i] =0,din[1][i]=0,s[0][i]=0,s[1][i]=0; d[1][0]=0; for (i=1;i<=2*n+1;i++) { j=0; int min=n+2; int h=0; for (j=1;j<=n+1;j++) if (d[h][j]<d[h][min]&&s[0][j]==0) min=j; for (j=0;j<=n;j++) if (d[1][j]<d[h][min]&&s[1][j]==0) min=j,h=1; if (min==n+2) break; for (j=1;j<=n+1;j++) { if (fl[min][j]==0&&h==0&&d[(h+1)%2][j]>d[h][min]+v[min][j]) { if (j==n+1) gasit=1; din[(h+1)%2][j]=min; d[(h+1)%2][j]=d[h][min]+v[min][j]; } if (fl[j][min]==1&&h==1&&d[0][j]>d[1][min]-v[j][min]) { if (j==n+1) gasit=1; din[(h+1)%2][j]=min; d[(h+1)%2][j]=d[h][min]-v[j][min]; } } s[h][min]=1; } } void solve() { gasit=1; while (gasit==1) { gasit=0; findpath(); if (gasit==0) break; fl[n+1][din[0][n+1]]=0; int h=1; i=din[0][n+1]; while (i!=0) { if (h==0) fl[i][din[0][i]]=0; if (h==1) fl[din[1][i]][i]=1; i=din[h][i]; h=(h+1)%2; } } } void writedata() { long int tot=0; for (i=1;i<=n;i++) for (j=1;j<=n;j++) if (fl[i][j]==1) tot+=v[i][j]; printf("%ld",tot); } void main() { readdata(); solve(); writedata(); } > As I know it is placed in some of the Bulgarian internet sites, but, sorry, I don't know where right...I hate submitting not mine algorithms. :) |
|