program NOIP2003_1_Network;
 const
 maxn=200;maxp=200;
 var
 i,j,n,p,maxlayer:integer;
 w:array[0..maxp]of longint;
 start,terminal:array[0..maxp]of byte;
 u,c:array[0..maxn]of longint;
 layer:array[0..maxn]of byte;
 f1,f2:text;fn1,fn2,fileNo:string;
 flag:boolean;
 begin
 write('Input fileNo:');
 readln(fileNo);
 fn1:='network.in'+fileNo;
 fn2:='network.ou'+fileNo;
 assign(f1,fn1);reset(f1);
 assign(f2,fn2);rewrite(f2);
 readln(f1,n,p);
 for i:=1 to n do readln(f1,c[i],u[i]);
 fillchar(layer,sizeof(layer),0);
 for i:=1 to p do begin
 readln(f1,start[i],terminal[i],w[i]);
 layer[terminal[i]]:=layer[start[i]]+1;
 end;
 close(f1);
 maxlayer:=layer[terminal[p]];
 for i:=1 to n do
 if layer[i]>0 then begin
 for j:=1 to p do
 if (terminal[j]=i) and (c[start[j]]>0)
 then c[i]:=c[i]+w[j]*c[start[j]];
 c[i]:=c[i]-u[i];
 end;
 flag:=true;
 for i:=1 to n do
 if (layer[i]=maxlayer) and (c[i]>0) then begin
 writeln(f2,i,' ',c[i]);
 flag:=false;
 end;
 if flag then writeln(f2,'NULL');
 close(f2);
 end.

program NOIP2003_2_Logic;
 const
 maxm=20;
 dow:array[1..7]of string=('Sunday.','Monday.','Tuesday.','Wednesday.',
 'Thursday.','Friday.','Saturday.');
 var
 i,j,k,weekday,m,n,p,p1,p2,p3,index,resolution,total1,total2:byte;
 name:array[1..maxm]of string;
 witness10,witness20:array[1..100]of byte;
 witness1,witness2:array[1..100]of string;
 name0,temp,temp0,temp1,temp2:string;
 truth,truth0:array[1..maxm]of byte;
 f1,f2:text;fn1,fn2,fileNo:string;
 flag:boolean;
 begin
 write('Input fileNo:');readln(fileNo);
 fn1:='logic.in'+fileNo;fn2:='logic.ou'+fileNo;
 assign(f1,fn1);reset(f1);assign(f2,fn2);rewrite(f2);
 readln(f1,m,n,p);
 for i:=1 to m do readln(f1,name[i]);
 total1:=0;total2:=0;
 for i:=1 to p do begin
 readln(f1,temp);
 index:=pos(': ',temp);
 temp1:=copy(temp,1,index-1);
 temp2:=copy(temp,index+2,length(temp)-index-1);
 if (temp2='I am guilty.') or (temp2='I am not guilty.') then
 for j:=1 to m do
 if name[j]=temp1 then begin
 inc(total1);
 witness10[total1]:=j;
 witness1[total1]:=temp2;
 break;
 end;
 if (pos(' is guilty.',temp2)>0) or (pos(' is not guilty.',temp2)>0) then begin
 temp0:=copy(temp2,1,pos(' is ',temp2)-1);
 flag:=false;
 for k:=1 to m do
 if temp0=name[k] then begin
 flag:=true;
 break;
 end;
 if flag then
 for j:=1 to m do
 if name[j]=temp1 then begin
 inc(total1);
 witness10[total1]:=j;
 witness1[total1]:=temp2;
 break;
 end;
 end;
 flag:=false;
 for j:=1 to 7 do
 if temp2='Today is '+ dow[j] then begin
 flag:=true;
 break;
 end;
 if flag then
 for j:=1 to m do
 if name[j]=temp1 then begin
 inc(total2);
 witness20[total2]:=j;
 witness2[total2]:=temp2;
 break;
 end;
 end;
 close(f1);
 resolution:=0;
 for i:=1 to m do begin
 if resolution>1 then break;
 fillchar(truth,sizeof(truth),0);
 for j:=1 to total1 do begin
 if witness1[j]='I am guilty.' then begin
 if i=witness10[j] then
 case truth[i] of
 0:truth[i]:=1;
 2:truth[i]:=3;
 end
 else
 case truth[witness10[j]] of
 0:truth[witness10[j]]:=2;
 1:truth[witness10[j]]:=3;
 end;
 end;
 if witness1[j]='I am not guilty.' then begin
 if i=witness10[j] then
 case truth[i] of
 0:truth[i]:=2;
 1:truth[i]:=3;
 end
 else
 case truth[witness10[j]] of
 0:truth[witness10[j]]:=1;
 2:truth[witness10[j]]:=3;
 end;
 end;
 if (pos(' is guilty.',witness1[j])>0) then begin
 temp:=copy(witness1[j],1,pos(' is guilty.',witness1[j])-1);
 if name[i]=temp then
 case truth[witness10[j]] of
 0:truth[witness10[j]]:=1;
 2:truth[witness10[j]]:=3;
 end
 else
 case truth[witness10[j]] of
 0:truth[witness10[j]]:=2;
 1:truth[witness10[j]]:=3;
 end;
 end;
 if (pos(' is not guilty.',witness1[j])>0) then begin
 temp:=copy(witness1[j],1,pos(' is not guilty.',witness1[j])-1);
 if name[i]=temp then
 case truth[witness10[j]] of
 0:truth[witness10[j]]:=2;
 1:truth[witness10[j]]:=3;
 end
 else
 case truth[witness10[j]] of
 0:truth[witness10[j]]:=1;
 2:truth[witness10[j]]:=3;
 end;
 end;
 end;
 if total2>0 then begin
 for k:=1 to m do truth0[k]:=truth[k];
 for weekday:=1 to 7 do begin
 for k:=1 to m do truth[k]:=truth0[k];
 for j:=1 to total2 do
 if pos(dow[weekday],witness2[j])>0 then
 case truth[witness20[j]] of
 0:truth[witness20[j]]:=1;
 2:truth[witness20[j]]:=3;
 end
 else
 case truth[witness20[j]] of
 0:truth[witness20[j]]:=2;
 1:truth[witness20[j]]:=3;
 end;
 p1:=0;p2:=0;p3:=0;
 for k:=1 to m do if truth[k]=1 then inc(p1);
 for k:=1 to m do if truth[k]=2 then inc(p2);
 for k:=1 to m do if truth[k]=3 then inc(p3);
 if (p1<=m-n) and (p2<=n) and (p3=0) then begin
 name0:=name[i];
 inc(resolution);
 break;
 end;
 end;
 end;
 p1:=0;p2:=0;p3:=0;
 for k:=1 to m do if truth[k]=1 then inc(p1);
 for k:=1 to m do if truth[k]=2 then inc(p2);
 for k:=1 to m do if truth[k]=3 then inc(p3);
 if (p1<=m-n) and (p2<=n) and (p3=0) and (name0<>name[i]) then begin
 name0:=name[i];
 inc(resolution);
 end;
 end;
 if resolution=1 then writeln(f2,name0);
 if resolution=0 then writeln(f2,'Impossible');
 if resolution>1 then writeln(f2,'Cannot Determine');
 close(f2);
 end.

{$N+}
program NOIP2003_3_Tree;
 const
 maxn=30;
 var
 i,j,n,d:byte;
 a:array[1..maxn]of byte;
 value:array[1..maxn,1..maxn]of comp;
 root:array[1..maxn,1..maxn]of byte;
 s,temp:comp;
 f1,f2:text;fn1,fn2,fileNo:string;
 procedure preorder(p1,p2:byte);
 begin
 if p2>=p1 then begin
 write(f2,root[p1,p2],' ');
 preorder(p1,root[p1,p2]-1);
 preorder(root[p1,p2]+1,p2);
 end;
 end;
 begin
 write('Input fileNo:');readln(fileNo);
 fn1:='tree.in'+fileNo;fn2:='tree.ou'+fileNo;
 assign(f1,fn1);reset(f1);
 assign(f2,fn2);rewrite(f2);
 readln(f1,n);
 for i:=1 to n do read(f1,a[i]);
 close(f1);
 fillchar(value,sizeof(value),0);
 for i:=1 to n do begin
 value[i,i]:=a[i];
 root[i,i]:=i;
 end;
 for i:=1 to n-1 do begin
 value[i,i+1]:=a[i]+a[i+1];
 root[i,i+1]:=i;
 end;
 for d:=2 to n-1 do begin
 for i:=1 to n-d do begin
 s:=value[i,i]+value[i+1,i+d];
 root[i,i+d]:=i;
 for j:=1 to d do begin
 temp:=value[i+j,i+j]+value[i,i+j-1]*value[i+j+1,i+d];
 if temp>s then begin
 s:=temp;root[i,i+d]:=i+j;
 end;
 end;
 temp:=value[i,i+d-1]+value[i+d,i+d];
 if temp>s then begin
 s:=temp;root[i,i+d]:=i+d+1;
 end;
 value[i,i+d]:=s;
 end;
 end;
 writeln(f2,value[1,n]:0:0);
 preorder(1,n);
 close(f2);
 end.

program NOIP2003_4_Epidemic;
 const
 maxn=300;maxp=300;
 type
 node=array [0..maxp] of integer;
 var
 i,n,p,min,max,temp,s,smin:integer;
 a:array[1..maxn] of ^node;
 f1,f2:text;fn1,fn2,fileNo:string;
 procedure try(i:integer);
 var
 root1,root2,j,k,m,temp,s0:integer;b:node;flag:boolean;
 begin
 if a[i]^[0]<=1 then begin
 if s<smin then smin:=s;
 exit;
 end;
 s0:=s;
 flag:=true;
 for j:=1 to a[i]^[0] do if (a[a[i]^[j]]^[0]>0) then begin
 flag:=false;
 s:=s0+a[i]^[0]-1;
 if j=1 then root1:=2 else root1:=1;
 root2:=a[i]^[root1];
 temp:=a[root2]^[0];
 for k:=1 to temp do b[k]:=a[root2]^[k];
 for k:=1 to a[i]^[0] do
 if (k<>j) and (k<>root1) then begin
 for m:=1 to a[a[i]^[k]]^[0] do
 a[root2]^[a[root2]^[0]+m]:=a[a[i]^[k]]^[m];
 a[root2]^[0]:=a[root2]^[0]+a[a[i]^[k]]^[0];
 end;
 try(root2);
 a[root2]^[0]:=temp;
 for m:=1 to temp do a[root2]^[m]:=b[m];
 end;
 if flag then begin
 s:=s0+a[i]^[0]-1;
 if s<smin then smin:=s;
 exit;
 end;
 end;
 begin
 write('Input fileNo:');readln(fileNo);
 fn1:='Epidemic.in'+fileNo;fn2:='Epidemic.ou'+fileNo;
 assign(f1,fn1);reset(f1);assign(f2,fn2);rewrite(f2);
 readln(f1,n,p);
 for i:=1 to n do new(a[i]);
 for i:=1 to n do a[i]^[0]:=0;
 for i:=1 to p do begin
 readln(f1,min,max);
 if min>max then begin
 temp:=min;min:=max;max:=temp
 end;
 inc(a[min]^[0]);
 a[min]^[a[min]^[0]]:=max;
 end;
 close(f1);
 s:=1;smin:=300;try(1);
 writeln(f2,smin);close(f2);
 end.

2002
program NOIPG1;
 const
 maxn=100;
 var
 i,j,n,step:integer;ave:longint;
 a:array[1..maxn]of integer;
 f:text;filename:string;
 begin
 write('Input filename:');readln(filename);
 assign(f,filename);reset(f);
 readln(f,n);ave:=0;
 for i:=1 to n do begin
 read(f,a[i]);
 inc(ave,a[i]);
 end;
 ave:=ave div i;
 for i:=1 to n do dec(a[i],ave);
 i:=1;j:=n;
 while a[i]=0 do inc(i);
 while a[j]=0 do dec(j);
 while (i<j) do begin
 inc(a[i+1],a[i]);
 a[i]:=0;
 inc(step);
 inc(i);
 while a[i]=0 do inc(i);
 end;
 writeln(step);
 end.

2002
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-,Y-}
{$M 8192,0,655360}
program NOIPG2;
 const maxn=2300;
 type
 node=record{定义节点数据类型}
 str:string[115];dep:byte;
 end; {str表示字串，其长度不会超过115（长度超过115的字串
 不可能通过变换成为目标字串，因为题目限定变换10次之内，且串长
 不超过20，即起始串最多可经过5次变换时增长，中间串的最大长度
 为20+5*19=115，否则经过余下的步数不可能变为长度不超过20的
 目标串），dep表示深度}
 ctype=array[1..maxn]of ^node;
 bin=0..1;
 var
 maxk:byte;c:array [0..1]of ctype;
 x0:array[0..6,0..1]of string[20];
 filename:string;
 open,closed:array [0..1] of integer;
 procedure Init;{读取数据，初始化}
 var f:text;temp:string;i,j:integer;
 begin
 for i:=0 to 1 do
 for j:=1 to maxn do new(c[i,j]);
 write('Input filename:');readln(filename);
 assign(f,filename);reset(f);i:=0;
 while not eof(f) and (i<=6) do begin
 readln(f,temp);
 x0[i,0]:=copy(temp,1,pos(' ',temp)-1);
 x0[i,1]:=copy(temp,pos(' ',temp)+1,length(temp));
 inc(i);
 end;
 maxk:=i-1;close(f);
 end;
 procedure calc;
 var i,j,k:integer;st:bin;
 d:string;f:text;
 procedure bool(st:bin);{判断是否到达目标状态或双向搜索相遇}
 var i:integer;
 begin
 if x0[0,1-st]=c[st,closed[st]]^.str then begin
 {如果到达目标状态，则输出结果，退出}
 writeln(c[st,closed[st]]^.dep);
 halt;
 end;
 for i:=1 to closed[1-st] do
 if c[st,closed[st]]^.str=c[1-st,i]^.str then begin
 {如果双向搜索相遇（即得到同一节点），
 则输出结果（2个方向搜索的步数之和），退出}
 writeln(c[st,closed[st]]^.dep+c[1-st,i]^.dep);
 halt;
 end;
 end;
 procedure checkup(st:bin);{判断节点是否与前面重复}
 var i:integer;
 begin
 for i:=1 to closed[st]-1 do
 if c[st,i]^.str=c[st,closed[st]]^.str then begin
 dec(closed[st]);exit;{如果节点重复，则删除本节点}
 end;
 bool(st);{如果节点不重复，再判断是否到达目标状态}
 end;
 procedure expand(st:bin);{扩展产生新节点}
 var i,j,k,lx,ld:integer;
 begin
 inc(open[st]);d:=c[st,open[st]]^.str;{队首节点出队}
 k:=c[st,open[st]]^.dep;ld:=length(d);
 for i:=1 to maxk do begin
 {从队首节点（父节点）出发产生新节点（子节点）}
 lx:=length(x0[i,st]);
 for j:=1 to ld do begin
 if (copy(d,j,lx)=x0[i,st]) and (length(copy(d,1,j-1)+x0[i,1-st]
 +copy(d,j+lx,ld))<=115) then begin
 {如果新节点的串长超过115，则不扩展！即剪掉此枝}
 if closed[st]>=maxn then exit;{如果队列已满，只好退出}
 inc(closed[st]);{新节点入队}
 c[st,closed[st]]^.str:=copy(d,1,j-1)+x0[i,1-st]+copy(d,j+lx,ld);
 c[st,closed[st]]^.dep:=k+1;{子节点深度=父节点深度+1}
 checkup(st);{检查新节点是否重复}
 end;
 end;
 end;
 end;
 Begin
 for st:=0 to 1 do begin{正向(st=0)逆向(st=1)搜索节点队列初始化}
 open[st]:=0;closed[st]:=1;
 c[st,closed[st]]^.str:=x0[0,st];c[st,closed[st]]^.dep:=0;
 bool(st);
 end;
 repeat
 {选择节点数较少且队列未空、未满、深度未达到10的方向先扩展}
 if (open[0]<=open[1]) and not ((open[0]>=closed[0]) or
 (closed[0]>=maxn) or (c[0,closed[0]]^.dep>10)) then expand(0);
 if (open[1]<=open[0]) and not ((open[1]>=closed[1]) or
 (closed[1]>=maxn) or (c[1,closed[1]]^.dep>10)) then expand(1);
 {如果一方搜索终止，继续另一方的搜索，直到两个方向都终止}
 if not ((open[0]>=closed[0]) or (closed[0]>=maxn) or
 (c[0,closed[0]]^.dep>10)) then expand(0);
 if not ((open[1]>=closed[1]) or (closed[1]>=maxn) or
 (c[1,closed[1]]^.dep>10)) then expand(1);
 until (open[0]>=closed[0]) or (c[0,closed[0]]^.dep>10) or (closed[0]>=maxn)
 and (closed[1]>=maxn) or (open[1]>=closed[1]) or (c[1,closed[1]]^.dep>10);
 {终止条件：任一方队空（无解）或搜索深度超过10（10步内无解）
 或双方均溢出（可能有解也可能无解，应尽量避免，要尽量把节
 点数组开大一点，采用双向搜索，采取剪枝措施等）}
 End;
 BEGIN
 init; calc; writeln('NO ANSWER!')
 END.

2002
program NOIPG3;
 const g=10{重力加速度};e=1E-5;{小车接受小球的极限距离}
 var H,s1,v,l,k,t1,t2,Vmin,Vmax:real;
 n2,n1,num,n:integer;
 begin
 readln(h,s1,v,l,k,n);num:=-1;
 t1:=sqrt(2*h/g);{小球落地时间}
 if h<=k+e then t2:=0 else t2:=sqrt(2*(h-k-e)/g);{小球落到小车上的最短时间}
 if s1-v*t2+L+e<0 
 then num:=0
 else n2:=trunc(s1-v*t2+L+e);{小车接受的球的最大编号为n2}
 if n2>n-1 then n2:=n-1;{n2取trunc(s1-v*t2+L+e)与n-1的较小值}
 if s1-v*t1-e<=0 
 then n1:=0
 else if s1-v*t1-e>n-1
 then num:=0
 else if (s1-v*t1-e)=trunc(s1-v*t1-e)
 then n1:=trunc(s1-v*t1-e){小车接受的球的最小编号为n1}
 else n1:=trunc(s1-v*t1-e)+1;
 if num=-1 then num:=n2-n1+1;{小车接受的球的个数为num}
 writeln(num);
 end.

2002
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 65520,0,655360}
program NOIPG4;
 const maxn=50;maxk=3;
 type rect=record{定义"矩形"数据类型}
 l,r,t,b:word;{矩形的左边，右边，下边，上边距坐标轴的距离}
 end;
 vxy=record{定义"点"数据类型}
 x,y:word;{点的横、纵坐标}
 end;
 var ju:array[1..maxk]of rect;
 v:array[1..maxn,0..2] of vxy;v0:vxy;
 n,k,i,j,ii,jj:byte;f:text;filename:string;
 Smin,temp:longint;
 function intersect(jui,juj:rect):boolean;{判断两矩形是否有公共点}
 var b1,b2,t1,t2,l1,l2,r1,r2:word;
 begin
 b1:=jui.b;b2:=juj.b;t1:=jui.t;t2:=juj.t;
 l1:=jui.l;l2:=juj.l;r1:=jui.r;r2:=juj.r;
 intersect:=((l2<=r1) and (l2>=l1) or (r2<=r1) and (r2>=l1) or (l2<=l1)
 and (r2>=r1)) and ((t2<=b1) and (t2>=t1) or (b2<=b1) and (b2>=t1)
 or (b2>=b1) and (t2<=t1));
 end;
 function area(ju:rect):longint;{求矩形的面积}
 var temp:longint;
 begin
 temp:=ju.b-ju.t;
 area:=temp*(ju.r-ju.l);
 end;
 procedure insert(v:vxy;var ju:rect);{将点放入矩形}
 begin
 if v.x<ju.l then ju.l:=v.x;
 if v.x>ju.r then ju.r:=v.x;
 if v.y<ju.t then ju.t:=v.y;
 if v.y>ju.b then ju.b:=v.y;
 end;
 procedure init;{初始化}
 begin
 write('Input filename:');readln(filename);
 assign(f,filename);reset(f);readln(f,n,k);
 for i:=1 to n do begin
 read(f,v[i,0].x,v[i,0].y);
 v[i,1].x:=v[i,0].x;v[i,1].y:=v[i,0].y;
 end;
 for i:=1 to n-1 do{按横坐标升序排列各点，存入v[i,0]}
 for j:=i+1 to n do
 if v[i,0].x>v[j,0].x then begin
 v0:=v[i,0];v[i,0]:=v[j,0];v[j,0]:=v0;
 end;
 for i:=1 to n-1 do{按纵坐标升序排列各点，存入v[i,1]}
 for j:=i+1 to n do
 if v[i,1].y>v[j,1].y then begin
 v0:=v[i,1];v[i,1]:=v[j,1];v[j,1]:=v0;
 end;
 end;
 procedure solve;{核心计算}
 begin
 smin:=maxlongint;
 case k of
 1:begin{K=1的情形}
 ju[1].b:=v[n,1].y;ju[1].t:=v[1,1].y;
 ju[1].r:=v[n,0].x;ju[1].l:=v[1,0].x;
 smin:=area(ju[1]);
 end;
 2:for jj:=0 to 1 do begin{K=2的情形}
 {flag=0,1的情形}
 ju[1].b:=v[1,jj].y;ju[1].t:=v[1,jj].y;
 ju[1].r:=v[1,jj].x;ju[1].l:=v[1,jj].x;
 for i:=2 to n do begin
 insert(v[i-1,jj],ju[1]);{将第i-1点放入矩形1}
 ju[2].b:=v[i,jj].y;ju[2].t:=v[i,jj].y;{将第i至n点放入矩形2}
 ju[2].r:=v[i,jj].x;ju[2].l:=v[i,jj].x;
 for ii:=i+1 to n do insert(v[ii,jj],ju[2]);
 if not intersect(ju[1],ju[2]) then begin{如果两矩形不交叉}
 temp:=0;for ii:=1 to k do temp:=temp+area(ju[ii]);
 if temp<smin then smin:=temp;
 end;
 end;
 end;
 3:begin
 for jj:=0 to 1 do begin {flag=0,1的情形}
 ju[1].b:=v[1,jj].y;ju[1].t:=v[1,jj].y;
 ju[1].r:=v[1,jj].x;ju[1].l:=v[1,jj].x;
 for i:=2 to n-1 do begin
 insert(v[i-1,jj],ju[1]);
 ju[2].b:=v[i,jj].y;ju[2].t:=v[i,jj].y;
 ju[2].r:=v[i,jj].x;ju[2].l:=v[i,jj].x;
 if intersect(ju[1],ju[2]) then continue;
 for j:=i+1 to n do begin
 insert(v[j-1,jj],ju[2]);
 ju[3].b:=v[j,jj].y;ju[3].t:=v[j,jj].y;
 ju[3].r:=v[j,jj].x;ju[3].l:=v[j,jj].x;
 for ii:=j+1 to n do insert(v[ii,jj],ju[3]);
 if intersect(ju[2],ju[3]) then continue;
 temp:=0;for ii:=1 to k do temp:=temp+area(ju[ii]);
 if temp<smin then smin:=temp;
 end;
 end;
 end;

 {flag=2的情形:先竖直划分大矩形；再在右矩形中水平划分}


 ju[1].b:=v[1,0].y;ju[1].t:=v[1,0].y;
 ju[1].r:=v[1,0].x;ju[1].l:=v[1,0].x;
 for i:=2 to n-1 do begin
 for ii:=1 to n do v[ii,2]:=v[ii,0];{所有点按横坐标升序排列，存入v[i,2]}
 for ii:=i to n-1 do{将点i至n按纵坐标升序排列，存入v[i,2]}
 for jj:=ii+1 to n do
 if v[ii,2].y>v[jj,2].y then begin
 v0:=v[ii,2];v[ii,2]:=v[jj,2];v[jj,2]:=v0;
 end;{结果：所有点先按横坐标升序排列，然后点i至n按纵坐标升序排列}
 insert(v[i-1,2],ju[1]);{将第i-1点放入矩形1}
 ju[2].b:=v[i,2].y;ju[2].t:=v[i,2].y;{将第i点放入矩形2}
 ju[2].r:=v[i,2].x;ju[2].l:=v[i,2].x;
 if intersect(ju[1],ju[2]) then continue;
 for j:=i+1 to n do begin
 insert(v[j-1,2],ju[2]);{将第j-1点放入矩形2}
 ju[3].b:=v[j,2].y;ju[3].t:=v[j,2].y;{将第j至n点放入矩形3}
 ju[3].r:=v[j,2].x;ju[3].l:=v[j,2].x;
 for ii:=j+1 to n do insert(v[ii,2],ju[3]);
 if intersect(ju[2],ju[3]) then continue;
 temp:=0;for ii:=1 to k do temp:=temp+area(ju[ii]);
 if temp<smin then smin:=temp;
 end;
 end;

 {flag=3的情形}
 for j:=3 to n do begin
 for ii:=1 to n do v[ii,2]:=v[ii,0];
 for ii:=1 to j-2 do
 for jj:=ii+1 to j-1 do
 if v[ii,2].y>v[jj,2].y then begin
 v0:=v[ii,2];v[ii,2]:=v[jj,2];v[jj,2]:=v0;
 end;
 ju[3].b:=v[j,2].y;ju[3].t:=v[j,2].y;
 ju[3].r:=v[j,2].x;ju[3].l:=v[j,2].x;
 for ii:=j+1 to n do insert(v[ii,2],ju[3]);
 for i:=2 to j-1 do begin
 ju[2].b:=v[i,2].y;ju[2].t:=v[i,2].y;
 ju[2].r:=v[i,2].x;ju[2].l:=v[i,2].x;
 for ii:=i+1 to j-1 do insert(v[ii,2],ju[2]);
 ju[1].b:=v[1,2].y;ju[1].t:=v[1,2].y;
 ju[1].r:=v[1,2].x;ju[1].l:=v[1,2].x;
 for ii:=2 to i-1 do insert(v[ii,2],ju[1]);
 if intersect(ju[1],ju[2]) or intersect(ju[2],ju[3]) or
 intersect(ju[1],ju[3]) then continue;
 temp:=0;for ii:=1 to k do temp:=temp+area(ju[ii]);
 if temp<smin then smin:=temp;
 end;
 end;

 {flag=4的情形}
 for j:=3 to n do begin
 for ii:=1 to n do v[ii,2]:=v[ii,1];
 for ii:=1 to j-2 do
 for jj:=ii+1 to j-1 do
 if v[ii,2].x>v[jj,2].x then begin
 v0:=v[ii,2];v[ii,2]:=v[jj,2];v[jj,2]:=v0;
 end;
 ju[3].b:=v[j,2].y;ju[3].t:=v[j,2].y;
 ju[3].r:=v[j,2].x;ju[3].l:=v[j,2].x;
 for ii:=j+1 to n do insert(v[ii,2],ju[3]);
 for i:=2 to j-1 do begin
 ju[2].b:=v[i,2].y;ju[2].t:=v[i,2].y;
 ju[2].r:=v[i,2].x;ju[2].l:=v[i,2].x;
 for ii:=i+1 to j-1 do insert(v[ii,2],ju[2]);
 ju[1].b:=v[1,2].y;ju[1].t:=v[1,2].y;
 ju[1].r:=v[1,2].x;ju[1].l:=v[1,2].x;
 for ii:=2 to i-1 do insert(v[ii,2],ju[1]);
 if intersect(ju[1],ju[2]) or intersect(ju[2],ju[3]) or
 intersect(ju[1],ju[3]) then continue;
 temp:=0;for ii:=1 to k do temp:=temp+area(ju[ii]);
 if temp<smin then smin:=temp;
 end;
 end;

 {flag=5的情形}
 ju[1].b:=v[1,1].y;ju[1].t:=v[1,1].y;
 ju[1].r:=v[1,1].x;ju[1].l:=v[1,1].x;
 for i:=2 to n-1 do begin
 for ii:=1 to n do v[ii,2]:=v[ii,1];
 for ii:=i to n-1 do
 for jj:=ii+1 to n do
 if v[ii,2].x>v[jj,2].x then begin
 v0:=v[ii,2];v[ii,2]:=v[jj,2];v[jj,2]:=v0;
 end;
 insert(v[i-1,2],ju[1]);
 ju[2].b:=v[i,2].y;ju[2].t:=v[i,2].y;
 ju[2].r:=v[i,2].x;ju[2].l:=v[i,2].x;
 if intersect(ju[1],ju[2]) then continue;
 for j:=i+1 to n do begin
 insert(v[j-1,2],ju[2]);
 ju[3].b:=v[j,2].y;ju[3].t:=v[j,2].y;
 ju[3].r:=v[j,2].x;ju[3].l:=v[j,2].x;
 for ii:=j+1 to n do insert(v[ii,2],ju[3]);
 if intersect(ju[2],ju[3]) then continue;
 temp:=0;for ii:=1 to k do temp:=temp+area(ju[ii]);
 if temp<smin then smin:=temp;
 end;
 end;
 end;
 end;
 end;
 BEGIN{主程序}
 init;
 solve;
 writeln(smin);
 END.

2001 1
var
a,b,c,d,x,tmp:real; 
ansx,f:array[1..3] of real;
i,j:integer;

begin
readln(a,b,c,d);
for i:=1 to 3 do
f[i]:=1e12;
x:=-100;
while(x<=100) do
begin
tmp:=(d+x*(c+x*(b+x*a)));
j:=1;
for i:=2 to 3 do
if (f[i]>f[j]) then j:=i;
if (abs(tmp)<f[j]) then
begin
f[j]:=abs(tmp);
ansx[j]:=x;
end;
x:=x+0.01;
end;
for i:=1 to 3 do
for j:=i+1 to 3 do
if (ansx[i]>ansx[j]) then
begin
tmp:=ansx[i];
ansx[i]:=ansx[j];
ansx[j]:=tmp;
end;
writeln(ansx[1]:0:2,' ',ansx[2]:0:2,' ',ansx[3]:0:2);
end.

2001 2
const
maxn=200;
maxk=6;
var
n,k,i,j:longint;
f:array[0..maxn,0..maxk] of longint;


begin
readln(n,k);
f[0,0]:=1;
for i:=1 to n do
for j:=1 to k do
if(i>=j)then
f[i,j]:=f[i-j,j]+f[i-1,j-1];
writeln(f[n,k]);
end.

2001 3
{$r-,q-,s-,n+,g+}
const
maxn = 205;
maxk = 41;
var
p,n,k,caseno:integer;
s,tmps:string[maxn];
mlen:array[1..maxn] of integer;
word:array[1..6] of string;
g:array[0..maxn,0..maxn] of integer;
h:array[0..maxn,0..maxk] of integer;
i,j,u,v:Integer;

begin
assign(input,'input3.dat');
reset(input);

readln(caseno);
while(caseno>0) do
begin
dec(caseno);

{ init; }
readln(p,k);
n:=p*20;
s:='';
for i:=1 to p do
begin
readln(tmps);
s:=s+tmps;
end;
readln(p);
for i:=1 to p do
readln(word[i]);

{ precalc mlen }
for i:=1 to n do
begin
mlen[i]:=maxn;
for j:=1 to p do
if( (pos(word[j],copy(s,i,length(s)-i+1))=1) and (length(word[j])<mlen[i]) ) then
mlen[i]:=length(word[j]);
end;

{ precalc g }
for i:=1 to n do
for j:=1 to n do
begin
g[i][j]:=0;
for u:=i to j do
if(u+mlen[u]-1<=j) then
inc(g[i][j]);
end;

{ Dynamic Programming }
fillchar(h,sizeof(h),0);
for j:=1 to k do
for u:=j to n do
for v:=u to n do
if(h[u-1][j-1]+g[u][v]>h[v][j])then
h[v][j]:=h[u-1][j-1]+g[u][v];
writeln(h[n][k]);
end;

close(input);

end.

2001 4
const
maxn=100;
var
cityno:integer;
px,py,value:array[1..4*maxn] of real;
roadfee:array[1..maxn] of real;
mk:array[1..4*maxn] of boolean;
city:array[1..4*maxn] of integer;
flyfee:real;
A,B,n:integer;

function IsZero(x:real):boolean;
begin
if( (x>1e-12) or (x<-1e12) ) then
IsZero:=false
else
IsZero:=true;
end;

function distance(x1,y1,x2,y2:real):real;
begin
distance:=sqrt(sqr(x1-x2)+sqr(y1-y2));
end;

function CuiZhi(x0,y0,x1,y1,x2,y2:real):boolean;
begin
CuiZhi:=IsZero((y1-y0)*(y2-y0)+(x1-x0)*(x2-x0));
end;

function CountDistance(i,j:integer):real;
begin
if(city[i]<>city[j]) then
CountDistance:=distance(px[i],py[i],px[j],py[j])*flyfee
else
CountDistance:=distance(px[i],py[i],px[j],py[j])*roadfee[city[i]];
end;

procedure iswap(var x,y:integer);
var tmp:integer;
begin
tmp:=x;
x:=y;
y:=tmp;
end;

procedure Init;
var
i:integer;
i0,i1,i2,i3:integer;
begin
readln(cityno,flyfee,A,B);
n:=cityno*4;
for i:=1 to cityno do
begin
i0:=4*i;
i1:=i0-1;
i2:=i0-2;
i3:=i0-3;
readln(px[i0],py[i0],px[i1],py[i1],px[i2],py[i2],roadfee[i]);
if( not CuiZhi(px[i0],py[i0],px[i1],py[i1],px[i2],py[i2]) ) then
begin
if( CuiZhi(px[i1],py[i1],px[i0],py[i0],px[i2],py[i2]) ) then
iswap(i1,i0)
else
iswap(i2,i0);
end;
px[i3]:=px[i1]+px[i2]-px[i0];
py[i3]:=py[i1]+py[i2]-py[i0];
city[i0]:=i;
city[i1]:=i;
city[i2]:=i;
city[i3]:=i;
if( (i=A) or (i=B) ) then
roadfee[i]:=0;
end;

end;

procedure Dijkstra;
var
i,u,v:Integer;
begin
for i:=1 to n do
value[i]:=1e12;
A:=A*4;
B:=B*4;
value[A]:=0;
u:=A;
fillchar(mk,sizeof(mk),false);
while(u<>B) do
begin
for v:=1 to n do
if( (not mk[v]) and (value[u]+CountDistance(u,v)<value[v]) ) then
value[v]:=value[u]+CountDistance(u,v);
mk[u]:=true;
u:=-1;
for i:=1 to n do 
if( (not mk[i]) and ( (u<0) or (value[i]<value[u]) ) ) then
u:=i;
end;
end;

var
filename:string;
caseno:integer;
begin
readln(filename);
assign(input,filename);
reset(input);
readln(caseno);
while(caseno>0) do
begin
dec(caseno);
Init;
Dijkstra;
writeln(value[B]:0:2);
end;
close(input);
end.

http://www.kogle.net/down/
不错�