jiry_2's Blog

两个弗洛伊德+乘法原理，第二个弗洛伊德居然写错了。。调了半天才调出来，QAQ

program p1491;
	var
		b,f:array[1..300,1..300] of int64;
		w:array[1..300] of extended;
		n,m,i,j,k1,k2,k3,k:longint;
	begin
		fillchar(f,sizeof(f),0);
		fillchar(b,sizeof(b),$3f);
		readln(n,m);
		for i:=1 to m do begin
			readln(k1,k2,k3);
			if k3<b[k1,k2] then begin
				b[k1,k2]:=k3;
				b[k2,k1]:=k3;
				f[k1,k2]:=1;
				f[k2,k1]:=1;
			end;
		end;
		for k:=1 to n do 
			for i:=1 to n do
				for j:=1 to n do begin
					if (i=j) or (j=k) or (k=i) then continue;
					if b[i,k]+b[k,j]<b[i,j] then begin
						b[i,j]:=b[i,k]+b[k,j];
						f[i,j]:=f[i,k]*f[k,j];
					end else if b[i,k]+b[k,j]=b[i,j] then
						f[i,j]:=f[i,j]+f[i,k]*f[k,j];
				end;
		fillchar(w,sizeof(w),0);
		for k:=1 to n do
			for i:=1 to n do
				for j:=1 to n do
					if (i<>k) and (j<>k) and (b[i,k]+b[k,j]=b[i,j])and (i<>j)then
						w[k]:=w[k]+f[i,k]*f[k,j]/f[i,j];
		for i:=1 to n do
			writeln(w[i]:0:3);
	end.

最大权闭合子图，最大流水掉

program p1497;
	const
		maxn=1000000;
	type
		bian=record
			next,point,f:longint;
		end;
	var
		p,dst,x:array[0..100000] of longint;
		pd:array[0..60000] of boolean;
		b:array[0..1000000] of bian;
		tot,n,m,i,j,len,k1,k2,k3:longint;
	procedure ade(k1,k2,k3:longint);
		begin
			inc(len);
			b[len].point:=k2;
			b[len].next:=p[k1];
			b[len].f:=k3;
			p[k1]:=len;
		end;
	procedure add(k1,k2,k3:longint);
		begin
			ade(k1,k2,k3);
			ade(k2,k1,0);
		end;
	function bfs:boolean;
		var
			head,now,i,j:longint;
		begin
			fillchar(pd,sizeof(pd),false);
			x[1]:=0; pd[0]:=true; dst[0]:=0; head:=1; now:=0;
			while head>now do begin
				inc(now);
				i:=p[x[now]];
				while i<>-1 do begin
					j:=b[i].point;
					if (pd[j]=false) and (b[i].f>0) then begin
						dst[j]:=dst[x[now]]+1;
						pd[j]:=true;
						if j=n+m+1 then exit(true);
						inc(head);
						x[head]:=j;
					end;
					i:=b[i].next;
				end;
			end;
			exit(pd[n+m+1]);
		end;
	function min(k1,k2:longint):longint;
		begin
			if k1<k2 then exit(k1) else exit(k2);
		end;
	function change(k1,k2:longint):longint;
		var
			i,j,num,ans,k:longint;
		begin
			if (k1=n+m+1) or (k2=0) then exit(k2);
			ans:=0; i:=p[k1];
			while i<>-1 do begin
				j:=b[i].point;
				if (dst[j]=dst[k1]+1) and (b[i].f>0) then begin
					k:=change(j,min(k2,b[i].f));
					dec(k2,k); inc(ans,k);
					inc(b[i xor 1].f,k); dec(b[i].f,k);
					if k2=0 then break;
				end;
				i:=b[i].next;
			end;
			if ans=0 then dst[k1]:=-1;
			exit(ans);
		end;
	function dinic:longint;
		var
			num:longint;
		begin
			num:=0;
			while bfs=true do 
				num:=num+change(0,maxn);
			exit(num);
		end;
	begin
		readln(n,m);
		len:=-1;
		fillchar(p,sizeof(p),-1);
		fillchar(b,sizeof(b),0);
		for i:=1 to n do begin
			read(k1);
			add(i,n+m+1,k1);
		end;
		tot:=0;
		for i:=1 to m do begin
			readln(k1,k2,k3);
			add(n+i,k1,maxn);
			add(n+i,k2,maxn);
			add(0,n+i,k3);
			tot:=tot+k3;
		end;
		writeln(tot-dinic);
	end.

瞎搞搞，用勾股定理的通式

program p1041;
	var
		len,tot,r,i,j:longint;
		x:array[1..10000,1..2] of longint;
	function find(k:longint):longint;
		var	
			i,j,a,b,num,c,d:longint;
			bo:boolean;
		begin
			num:=0;
			for i:=2 to trunc(sqrt(k)) do
				if sqr(trunc(sqrt(k-i*i)))=k-i*i then begin
					a:=trunc(sqrt(k-i*i));
					b:=i;
					if (a<=b) or (a=0) or (b=0) then continue;
					c:=2*a*b; d:=a*a-b*b;
					a:=c; b:=d;
					if a>b then begin j:=a; a:=b; b:=j; end;
					bo:=false;
					for j:=1 to len do begin
						if a/x[j,1]=b/x[j,2] then begin
							bo:=true; break;
						end;
					end;
					if bo=false then begin
						num:=num+2;
						inc(len);
						x[len,1]:=a; x[len,2]:=b;
					end;
				end;
			exit(num);
		end;
	begin
		readln(r);
		tot:=1; len:=0;
		for i:=1 to trunc(sqrt(r)) do
			if r mod i=0 then begin
				if i<>r div i then
					tot:=tot+find(i)+find(r div i)
				else 
					tot:=tot+find(i);
			end;
		tot:=tot*4;
		writeln(tot);
	end.

大水题一只，开100个二维树状数组表示，每一种颜色就可以了，查询的复杂度只有logm*logn，非常快。由于最近手残的严重，我还是喜闻乐见的WA了一次。

program p1452;
	var
		x:array[1..305,1..305,1..105] of longint;
		f:array[1..305,1..305] of longint;
		i,j,n,m,q,k1,k2,k3,k4,k5,k6:longint;
	function lowbit(k:longint):longint;
		begin
			exit(k and (-k));
		end;
	procedure add(k1,k2,k3,k4:longint);
		var
			i,j:longint;
		begin
			i:=k1;
			while i<=n do begin
				j:=k2;
				while j<=m do begin
					inc(x[i,j,k3],k4);
					j:=j+lowbit(j);
				end;
				i:=i+lowbit(i);
			end;
		end;
	function find(k1,k2,k3:longint):longint;
		var
			i,j,num:longint;
		begin
			i:=k1; num:=0;
			while i>0 do begin
				j:=k2;
				while j>0 do begin
					inc(num,x[i,j,k3]);
					j:=j-lowbit(j);
				end;
				i:=i-lowbit(i);
			end;
			exit(num);
		end;
	begin
		readln(n,m);
		fillchar(x,sizeof(x),0);
		for i:=1 to n do
			for j:=1 to m do begin
				read(f[i,j]);
				add(i,j,f[i,j],1);
			end;
		read(q);
		for i:=1 to q do begin
			read(k1);
			if k1=1 then begin
				readln(k2,k3,k4);
				add(k2,k3,f[k2,k3],-1);
				add(k2,k3,k4,1);
				f[k2,k3]:=k4;
			end else begin
				readln(k2,k4,k3,k5,k6);
				writeln(find(k4,k5,k6)+find(k2-1,k3-1,k6)-find(k2-1,k5,k6)-find(k4,k3-1,k6));
			end;
		end;
	end.

赤果果的费用流，一下子就想出来了。类似于最少路径覆盖，但是要用费用流。由于保证可以一遍覆盖，那么就费用流也就保证是一条路径覆盖所有的点。这样的话就是最小路径覆盖的加强版。把每个点拆成两个点。如果I到J有一条边就往I1向J2连一条费用为时间，流量为1的边，由源向每个I1，每个I2向汇连一条费用为0流量为1的边，它的费用流结果就是答案。开始我很SB的把瞬移都当成边连进去，然后就T得一塌糊涂，其实只要从源向每个I2连一条流量为1费用为瞬移时间的边即可，简单粗暴，就AC了。

program p1927;
	type
		bian=record
			f,w,point,next:longint;
		end;
	var
		b:array[0..4000000] of  bian;
		p,after,d,t:array[-1..5000] of longint;
		x:array[1..500000] of longint;
		pd:array[-1..5000] of boolean;
		n,m,i,j,len,k1,k2,k3:longint;
	procedure ade(k1,k2,k3,k4:longint);
		begin
			inc(len);
			b[len].point:=k2;
			b[len].next:=p[k1];
			b[len].w:=k4;
			b[len].f:=k3;
			p[k1]:=len;
		end;
	procedure add(k1,k2,k3,k4:longint);
		begin
			ade(k1,k2,k3,k4);
			ade(k2,k1,0,-k4);
		end;
	function min(k1,k2:longint):longint;
		begin
			if k1<k2 then exit(k1) else exit(k2);
		end;
	function change:longint;
		var
			i,j,num,k:longint;
		begin
			i:=2*n+1; j:=after[i]; k:=maxlongint;
			while j<>-1 do begin
				k:=min(k,b[j].f);
				i:=b[j xor 1].point;
				j:=after[i];
			end;
			i:=2*n+1; j:=after[i]; num:=0;
			while j<>-1 do begin
				num:=num+k*b[j].w;
				inc(b[j xor 1].f,k);
				dec(b[j].f,k);
				i:=b[j xor 1].point;
				j:=after[i];
			end;
			exit(num);
		end;
	function spfa:boolean;
		var
			head,now,i,j:longint;
		begin
			fillchar(after,sizeof(after),-1);
			fillchar(pd,sizeof(pd),false);
			fillchar(d,sizeof(d),$3f);
			head:=1; now:=0;
			x[1]:=0; pd[0]:=true; d[0]:=0;
			while head>now do begin
				inc(now);
				i:=p[x[now]];
				while i<>-1 do begin
					j:=b[i].point;
					if (d[j]>d[x[now]]+b[i].w) and (b[i].f>0) then begin
						d[j]:=d[x[now]]+b[i].w;
						after[j]:=i;
						if pd[j]=false then begin
							pd[j]:=true;
							inc(head);
							x[head]:=j;
						end;
					end;
					i:=b[i].next;
				end;
				pd[x[now]]:=false;
			end;
			if after[2*n+1]=-1 then exit(false) else exit(true);
		end;
	function dinic:longint;
		var
			num:longint;
		begin
			num:=0;
			while spfa do
				num:=num+change;
			exit(num);
		end;
	begin
		readln(n,m);
		fillchar(p,sizeof(p),-1);
		fillchar(b,sizeof(b),0);
		len:=-1;
		for i:=1 to n do
			read(t[i]);
		for i:=1 to m do begin
			readln(k1,k2,k3);
			if k1<k2 then add(k1,k2+n,1,k3) else add(k2,k1+n,1,k3);
		end;
		for i:=1 to n do
			add(0,i+n,1,t[i]);
		for i:=0 to n do
			add(0,i,1,0);
		for i:=n+1 to n*2 do
			add(i,n*2+1,1,0);
		writeln(dinic);
	end.

开始以为是裸的匈牙利算法，然后就WA了。后来想过用费用流或者KM通过用加权来解决但是都无果而终。后来突然发现如果要一关关闯下去一旦有一关找不到匹配那么就闯关失败了，应该就要BREAK掉了，这样一搞果然就AC了。

program p1191;
	type
		bian=record
			next,point:longint;
		end;
	var
		aimy,p:array[1..3000] of longint;
		v:array[1..2000] of boolean;
		b:array[1..10000] of bian;
		tot,len,n,m,i,j,k1,k2:longint;
	procedure add(k1,k2:longint);
		begin
			inc(len);
			b[len].point:=k2;
			b[len].next:=p[k1];
			p[k1]:=len;
		end;
	function find(k:longint):boolean;
		var
			i,j:longint;
		begin
			if k=0 then exit(true);
			i:=p[k];
			while i<>0 do begin
				j:=b[i].point;
				if v[j]=false then begin	
					v[j]:=true;
					if find(aimy[j])=true then begin
						aimy[j]:=k;
						exit(true);
					end;
				end;
				i:=b[i].next;
			end;
			exit(false);
		end;
	begin
		readln(m,n);
		fillchar(p,sizeof(p),0);
		fillchar(b,sizeof(b),0);
		fillchar(aimy,sizeof(aimy),0);
		len:=0;
		for i:=1 to n do begin
			readln(k1,k2);
			add(i+m,k1+1);
			add(i+m,k2+1);
		end;
		tot:=0;
		for i:=m+1 to m+n do begin
			fillchar(v,sizeof(v),false);
			if find(i) then inc(tot) else break;
		end;
		writeln(tot);
	end.

program p1192;
	var
		i,j,n:int64;
	begin
		readln(n);
		j:=0;
		while n>0 do begin
			inc(j);
			n:=n div 2;
		end;
		writeln(j);
	end.

开始一直在想在线的查询，然后就被坑里面了。后来想想既然查询只有20W次步入全部记下来，然后以右界为关键字升序sort一下。然后从1到n扫一遍。利用树状数组，保证同一时刻树状数组中每种贝壳最多只存在一次，且其位置是当前这种贝壳位置的最右端。要达成这样只需要每次加入一个贝壳时把原来在树状数组中这个种类的贝壳删掉。当扫到某个区间的右界的时候就记下这个区间的答案，即为find(b)-find(a-1)。最后再按照原来的顺序把答案打出。要注意的是贝壳的编号可以为0，我就是被这个坑了然后W了一次，QAQ。运行时间依然有pascal特色，慢得出翔~

program p1787;
	type
		qj=record
			a,b:longint;
		end;
	var
		x,y:array[0..200000] of longint;
		num:array[0..1010000] of longint;
		q:array[1..400000] of qj;
		z,answer:array[0..400000] of longint;
		n,m,i,j:longint;
	function lowbit(k:longint):longint;
		begin
			exit(k and (-k));
		end;
	procedure add(k1,k2:longint);
		var
			i,j:longint;
		begin
			i:=k1;
			while i<=n do begin
				inc(x[i],k2);
				i:=i+lowbit(i);
			end;
		end;
	function find(k:longint):longint;
		var
			i,j:longint;
		begin
			i:=k; j:=0;
			while i>0 do begin
				j:=j+x[i];
				i:=i-lowbit(i);
			end;
			exit(j);
		end;
	procedure quick(first,en:longint);
		var
			i,j:longint;
		begin
			i:=first; j:=en; z[0]:=z[i];
			while i<j do begin
				while (i<j) and (q[z[0]].b<=q[z[j]].b) do dec(j);
				if i<j then z[i]:=z[j];
				while (i<j) and (q[z[0]].b>q[z[i]].b) do inc(i);
				if i<j then z[j]:=z[i];
			end;
			z[i]:=z[0];
			if i>first+1 then quick(first,i-1);
			if i<en-1 then quick(i+1,en);
		end;
	begin
		readln(n);
		for i:=1 to n do
			read(y[i]);
		readln(m);
		for i:=1 to m do begin
			readln(q[i].a,q[i].b);
			z[i]:=i;
		end;
		quick(1,m);
		j:=1;
		fillchar(x,sizeof(x),0);
		fillchar(num,sizeof(num),0);
		for i:=1 to n do begin
			add(i,1);
			if num[y[i]]<>0 then add(num[y[i]],-1);
			num[y[i]]:=i;
			while (j<=m) and (q[z[j]].b=i) do begin
				answer[z[j]]:=find(q[z[j]].b)-find(q[z[j]].a-1);
				inc(j);
			end;
			if j>m then break;
		end;
		for i:=1 to m do
			writeln(answer[i]);
	end.

如果从一个点到另一个点的时间都是1那么答案就是邻接矩阵自乘T次时B[1,N]的值，现在既然两点之间时间小于9，那么可以把每个点拆成9个，连成链状，如果I到J的时间为2，那么就由I向倒数第二个J连一条边。这样便可以使邻接矩阵中所有边的权值都为1，那么就可以用快速幂+矩阵乘法做了，要注意非常容易栈溢出。

program p1297;
	type
		arr=array[1..100,1..100] of longint;
	var
		b:array[1..10,1..10] of longint;
		z,x,y,k1,k2:arr;
		t,len,n,i,j,k:longint;
		ch:char;
	function chen(a2:longint):arr;
		var
			i,j,k:longint;
		begin	
			k1:=z; if a2=1 then k2:=z else k2:=x; 
			fillchar(chen,sizeof(chen),0);
			for i:=1 to n do
				for j:=1 to n do
					for k:=1 to n do
						chen[i,j]:=(k1[i,k]*k2[k,j]+chen[i,j]) mod 2009;
		end;
	function quick(k2:longint):arr;
		begin
			if k2=1 then exit(x);
			z:=quick(k2 div 2); z:=chen(1);
			if k2 mod 2=0 then exit(z);
			exit(chen(2));
		end;
	begin
		readln(n,t);
		for i:=1 to n do begin
			for j:=1 to n do begin
				read(ch);
				b[i,j]:=ord(ch)-ord('0');
			end;
			readln;
		end;
		fillchar(x,sizeof(x),0);
		for i:=1 to n do
			for j:=1 to n do begin
				if b[i,j]=0 then continue;
				x[i*9,j*9-b[i,j]+1]:=1;
				for k:=j*9-b[i,j]+2 to j*9 do
					x[k-1,k]:=1;
			end;
		n:=n*9;
		y:=quick(t);
		writeln(y[9,n]);
	end.

蛋疼的网络流，想了一会儿没思路看题解了。由于模型转换太神奇，自己百度。我这儿就贴代码了。

program p2597;
	type
		bian=record
			next,point,f,w:longint;
		end;
	var
		b:array[0..100000] of bian;
		p,d,inw,after:array[0..10000] of longint;
		pd:array[0..20000] of boolean;
		bi:array[1..200,1..200] of longint;
		x:array[1..500000] of longint;
		k,len,n,long,i,j:longint;
	procedure ade(k1,k2,k3,k4:longint);
		begin
			inc(len);
			b[len].point:=k2;
			b[len].next:=p[k1];
			b[len].f:=k3;
			b[len].w:=k4;
			p[k1]:=len;
		end;
	procedure add(k1,k2,k3,k4:longint);
		begin
			ade(k1,k2,k3,k4);
			ade(k2,k1,0,-k4);
		end;
	function spfa:boolean;
		var
			i,j,head,now:longint;
		begin
			fillchar(after,sizeof(after),-1);
			fillchar(pd,sizeof(pd),false);
			fillchar(d,sizeof(d),$3f);
			head:=1; now:=0; pd[0]:=true; x[1]:=0; d[0]:=0;
			while head<>now do begin
				now:=now+1;
				i:=p[x[now]];
				while i<>-1 do begin
					j:=b[i].point;
					if (d[x[now]]+b[i].w<d[j]) and (b[i].f>0) then begin
						d[j]:=d[x[now]]+b[i].w;
						after[j]:=i;
						if pd[j]=false then begin
							pd[j]:=true;
							head:=head+1;
							x[head]:=j;
						end;
					end;
					i:=b[i].next;
				end;
				pd[x[now]]:=false;
			end;
			if after[n*(n-1) div 2+n+1]=-1 then exit(false) else exit(true);
		end;
	function min(k1,k2:longint):longint;
		begin
			if k1<k2 then exit(k1) else exit(k2);
		end;
	function change:longint;
		var
			i,j,k,ans,num:longint;
		begin
			i:=n*(n-1) div 2+n+1; j:=after[i]; k:=maxlongint;
			while j<>-1 do begin
				k:=min(k,b[j].f);
				i:=b[j xor 1].point;
				j:=after[i];
			end;
			i:=n*(n-1) div 2+n+1; j:=after[i]; num:=0;
			while j<>-1 do begin
				num:=num+k*b[j].w;
				inc(b[j xor 1].f,k);
				dec(b[j].f,k);
				i:=b[j xor 1].point;
				j:=after[i];
			end;
			exit(num);
		end;
	function dinic:longint;
		var
			ans:longint;
		begin
			ans:=0;
			while spfa=true do
				ans:=ans+change;
			exit(ans);
		end;
	function find(k:longint):longint;
		var
			i,j:longint;
		begin
			i:=p[k];
			while i<>-1 do begin
				if (b[i].f=0) then exit(b[i].point);
				i:=b[i].next;
			end;
		end;
	begin
		fillchar(b,sizeof(b),0);
		fillchar(p,sizeof(p),-1);
		fillchar(inw,sizeof(inw),0);
		len:=-1;
		readln(n); long:=0;
		for i:=1 to n do
			for j:=1 to n do begin
				read(k);
				if i>=j then continue;
				inc(long);
				if k=0 then begin
					add(long,n*(n-1) div 2+i,1,0);
					inc(inw[i]);
				end else if k=1 then begin
					add(long,n*(n-1) div 2+j,1,0);
					inc(inw[j]);
				end else if k=2 then begin
					add(long,n*(n-1) div 2+i,1,0);
					add(long,n*(n-1) div 2+j,1,0);
					inc(inw[i]); inc(inw[j]);
				end;
			end;
		for i:=1 to n do
			for j:=1 to inw[i] do
				add(n*(n-1) div 2+i,n*(n-1) div 2+n+1,1,j*2-1);
		for i:=1 to n*(n-1) div 2 do
			add(0,i,1,0);
		writeln((n*(n-1)*(n-2) div 3+n*(n-1) div 2-dinic) div 2);
		long:=0;
		fillchar(bi,sizeof(bi),0);
		for i:=1 to n do
			for j:=i+1 to n do begin
				inc(long);
				if find(long)-n*(n-1) div 2=i then bi[i,j]:=0 else bi[i,j]:=1;
				bi[j,i]:=1-bi[i,j];
			end;
		for i:=1 to n do begin
			for j:=1 to n do
				write(bi[i,j],' ');
			writeln;
		end;
	end.