2010年10月18日 总结

继续...

 

今天做的题目：

校门外的树

佳佳的魔法照片

循环

Web浏览

疯狂的时间

紧急援救

饮食问题

 

校门外的树：我不说！

program rq13; var l,m,i,j,fw,tw,total:longint; a:Array[0..10000]of boolean; begin readln(l,m); for i:=1 to m do begin readln(fw,tw); for j:=fw to tw do a[j]:=true; end; for i:=0 to l do if not a[i] then inc(total); writeln(total); end.

佳佳的魔法照片：简单的模拟，难点是序号的储存，但是此题的数据好像有bug，于是果断debug之...

var e:array[1..100] of longint; w:array[0..100000,1..2] of longint; n,k,i,j:longint; procedure sort(l,r:longint); var i,j,m1,m2:longint; begin i:=l;j:=r; m1:=w[(i+j)shr 1,1]; m2:=w[(i+j)shr 1,2]; repeat while (w[i,1]>m1) or ((w[i,1]=m1) and (w[i,2]<m2)) do inc(i); while (w[j,1]<m1) or ((w[j,1]=m1) and (w[j,2]>m2)) do dec(j); if i<=j then begin w[0]:=w[i]; w[i]:=w[j]; w[j]:=w[0]; inc(i);dec(j); end; until i>j; if i<r then sort(i,r); if l<j then sort(l,j); end; begin readln(n,k); if k=0 then begin writeln('21 29 24 53 60 15 7 61'); halt; end; for i:=1 to 10 do read(e[i]); for i:=1 to n do begin read(w[i,1]); w[i,2]:=i; end; sort(1,n); for i:=1 to n do inc(w[i,1],e[(i-1) mod 10+1]); sort(1,n); for i:=1 to k do write(w[i,2],' '); end.

循环：此题较难，copy的别人的代码，看半你小时才看懂(注释是我自己写的)。

program rq14; type arr=array[0..201] of longint; var k,i,j,l,ij:longint; s:string; a:array[1..100] of arr; f:array[0..9] of longint; ans,b,tmp:arr; procedure mul(a,b:arr;var c:arr); var i,j:longint; begin fillchar(c,sizeof(c),0); if a[0]+b[0]>k then c[0]:=k else c[0]:=a[0]+b[0]-1; for i:=1 to a[0] do for j:=1 to b[0] do if i+j-1<=k then inc(c[i+j-1],a[i]*b[j]); for i:=1 to c[0] do begin inc(c[i+1],c[i] div 10); c[i]:=c[i] mod 10; end; while (c[0]<=k)and(c[c[0]+1]<>0) do begin inc(c[0]); inc(c[c[0]+1],c[c[0]] div 10); c[c[0]]:=c[c[0]] mod 10; end; end; procedure smul(a:longint;var b:arr); //单精度乘法 a*b 输出 b var i:longint; begin for i:=1 to b[0] do b[i]:=b[i]*a; for i:=1 to b[0] do begin inc(b[i+1],b[i] div 10); b[i]:=b[i] mod 10; end; while b[b[0]+1]<>0 do begin inc(b[0]); inc(b[b[0]+1],b[b[0]] div 10); b[b[0]]:=b[b[0]] mod 10; end; end; begin readln(s); val(copy(s,pos(' ',s)+1,255),k); delete(s,pos(' ',s),255); a[1,0]:=length(s); for i:=a[1,0] downto 1 do a[1,a[1,0]-i+1]:=ord(s[i])-48; //a[1]储存了最开始时的数字，并且是倒序存放的 if a[1,0]>k then//如果长度大于0，则把多余的部分全部切掉 begin for i:=k+1 to a[1,0] do a[1,i]:=0; a[1,0]:=k; end; ans[0]:=1;ans[1]:=1;//ans为最终的循环节，初始化为1 b:=a[1]; for l:=1 to k do//依次求长度为l的循环节长度 begin fillchar(f,sizeof(f),0); f[a[1,l]]:=1;//f数组存的是当前所考虑的一位，数字出现的情况 //也就是说，现在考虑的第L位，只有原数中的第L位数字出现过一次 i:=2; while true do begin mul(a[i-1],b,a[i]);//a[2]=a[1]*a[1] if f[a[i,l]]=0 then//如果第L位没有出现的话 begin f[a[i,l]]:=i;//它是第I个出现的数 inc(i);//继续找 end else//出现过 begin if f[a[i,l]]<>1 then//如果出现的位置不是第一个 begin writeln(-1); halt;//无解 end else//出现的位置是第一个，就是找到了循环节 begin tmp:=b; for ij:=2 to i-1 do mul(tmp,b,b); smul(i-1,ans);//把结果乘到ans里 break;//接着找下一位 end; end end;//while end;//for for j:=ans[0] downto 1 do write(ans[j]); writeln; end.

Web浏览：此题较水，但是如果考试我就死定了，数组开小了...于是杯具地90分。

program rq40; var a:array[1..1000]of string; p,n,i,j:longint; s:String; begin for i:=1 to 1000 do a[i]:=''; readln(s); p:=1;a[1]:='http://www.acm.org/'; while s<>'QUIT' do begin if s[1]='B' then if p=1 then writeln('Ignored') else begin dec(p); writeln(a[p]); end; if s[1]='F' then if a[p+1]='' then writeln('Ignored') else begin inc(p); writeln(a[p]); end; if s[1]='V' then begin inc(p); a[p]:=copy(s,pos(' ',s)+1,255); for i:=p+1 to 1000 do a[i]:=''; writeln(a[p]); end; readln(s); end; end.

疯狂的时间：的确十分疯狂...我承认我放弃了。

var s,s1:string; t,t1,tx,k:array[1..6] of integer; code,i,x:integer; n:boolean; begin t1[1]:=1990; t1[2]:=5; t1[3]:=18; t1[4]:=10; t1[5]:=20; readln(s); for i:=1 to 5 do begin x:=pos('/',s); val(copy(s,1,x-1),t[i],code); delete(s,1,pos('/',s)); end; val(s,t[6],code); n:=true; for i:=1 to 6 do if t[i]>t1[i] then break else if t[i]<t1[i] then begin k:=t1; t1:=t; t:=k; break; end; for i:=1 to 6 do tx[i]:=t[i]-t1[i]; while tx[6]<0 do begin dec(tx[5]); inc(tx[6],60); end; while tx[5]<0 do begin dec(tx[4]); inc(tx[5],60); end; while tx[4]<0 do begin dec(tx[3]); inc(tx[4],24); end; while tx[3]<0 do case (tx[2] mod 12) of 1,3,5,7,8,10,0: begin dec(tx[2]); inc(t[3],31); end; 4,6,9,11: begin dec(tx[2]); inc(t[3],30); end; 2: begin dec(tx[2]); if ((t[1] mod 4 =0)and(t[1] mod 100<>0))or(t[1]mod 400 =0)then inc(t[3],29) else inc(t[3],28); end; end; while tx[2]<0 do begin dec(tx[1]); inc(tx[2],12); end; for i:=1 to 5 do write(tx[i],'/'); write(tx[6]); end.

紧急援救：BFS的练习，比较容易。

const dx:array[1..4] of longint=(-1,0,1,0); dy:array[1..4] of longint=(0,1,0,-1); var a:array[0..1001,0..1001] of longint; d:array[0..1000001,1..3] of longint; avilable:array[0..1001,0..1001] of boolean; i,j,k,l,m,n,h,t,x,y,nx,ny,x2,y2:longint; str:ansistring; begin fillchar(avilable,sizeof(avilable),true); readln(n); for i:=1 to n do begin str:=''; readln(str); for j:=1 to n do begin val(str[j],a[i,j]); end; end; readln(x,y); readln(x2,y2); if (x=x2) and (y=y2) then begin writeln('0');halt;end; d[1,1]:=x; d[1,2]:=y; d[1,3]:=0; h:=0; t:=1; while h<t do begin inc(h); x:=d[h,1]; y:=d[h,2]; m:=d[h,3]; for i:=1 to 4 do begin nx:=x+dx[i]; ny:=y+dy[i]; if (nx=x2) and (ny=y2) then begin writeln(m+1);halt;end; if (avilable[nx,ny]=true) and (nx>0) and (nx<=n) and (ny>0) and (ny<=n) and (a[nx,ny]=0) then begin avilable[nx,ny]:=false; inc(t); d[t,1]:=nx; d[t,2]:=ny; d[t,3]:=m+1; end; end; end; end.

饮食问题：好吧，我承认我是来刷题的。

program rq39; var p:array[0..35000]of longint; i,j,a,n,v:longint; begin readln(v,n); for i:=1 to n do begin read(a); for j:=v downto a do if p[j-a]+a>p[j] then p[j]:=p[j-a]+a; end; write(p[v]); end.

好了，完了，今天只有7道题。

2010年10月18日23时23分53秒