額，由于某種原因，導緻昨天沒寫總結。今天的：
2^k進制數
采藥
英語課句型轉換
豬王争霸
提示問題
自然的謎語
掃雷
Fish學數學 之歸并版
2^k進制數：比較難，涉及到組合數學及高精度。
program rq8;
type
arr=array[0..200] of longint;
var
k,w,maxn,i,tmp:longint;
ans,b:arr;
procedure plus(a,b:arr;var c:arr);
var i:longint;
begin
fillchar(c,sizeof(c),0);
if a[0]>b[0] then
c[0]:=a[0]
else
c[0]:=b[0];
for i:=1 to c[0] do
begin
inc(c[i],a[i]+b[i]);
inc(c[i+1],c[i] div 1000);
c[i]:=c[i] mod 1000;
end;
if c[c[0]+1]<>0 then
inc(c[0]);
end;
procedure mul(a:arr;b:longint;var c:arr);
var i:longint;
begin
fillchar(c,sizeof(c),0);
if b=0 then begin c[0]:=1;c[1]:=0;exit;end;
c[0]:=a[0];
for i:=1 to c[0] do
begin
inc(c[i],a[i]*b);
inc(c[i+1],c[i] div 1000);
c[i]:=c[i] mod 1000;
end;
while c[c[0]+1]<>0 do
begin
inc(c[0]);
inc(c[c[0]+1],c[c[0]] div 1000);
c[c[0]]:=c[c[0]] mod 1000;
end;
end;
procedure divi(a:arr;b:longint;var c:arr);
var i,tmp:longint;
begin
fillchar(c,sizeof(c),0);c[0]:=a[0];tmp:=0;
for i:= c[0] downto 1 do
begin
tmp:=tmp*1000+a[i];
c[i]:=tmp div b;
tmp:=tmp mod b;
end;
while (c[0]>0)and(c[c[0]]=0) do dec(c[0]);
end;
procedure C(n,m:longint);
var i:longint;
begin
fillchar(b,sizeof(b),0);
b[0]:=1;b[1]:=1;
for i:=n downto n-m+1 do
mul(b,i,b);
for i:=2 to m do
divi(b,i,b);
end;
begin
readln(k,w);
maxn:=1;
for i:=1 to k do
maxn:=2*maxn;
ans[0]:=0;
for i:=2 to w div k do
begin
C(maxn-1,i);
plus(ans,b,ans);
end;
tmp:=1;
for i:=1 to w mod k do
tmp:=tmp*2;
dec(tmp);
for i:=1 to tmp do//統計w div k+1位的2^k進制數的個數
begin
C(maxn-1-i,w div k+1-1);
plus(ans,b,ans);
end;
write(ans[ans[0]]);
for i:=ans[0]-1 downto 1 do
if ans[i]<10 then
write('00',ans[i])
else
if ans[i]<100 then
write('0',ans[i])
else
write(ans[i]);
writeln;
end.
采藥：濫竽充數，無視之。
program rq15;
var
n,i,j,v:longint;
c,w:array[1..100]of longint;
f:array[0..1000]of longint;
begin
readln(v,n);
for i:=1 to n do
readln(c[i],w[i]);
for i:=1 to n do
for j:=v downto c[i] do
if f[j-c[i]]+w[i]>f[j] then
f[j]:=f[j-c[i]]+w[i];
writeln(f[v]);
end.
英語課句型轉換：把一個陳述句改寫為感歎句，提取出系動詞就可以了，注意主語是可以是數字的。
program rq146;
var
s,g,z,b,be:ansistring;
bl,br,l,i:longint;
begin
readln(g);
readln(s);
l:=length(s)-1;
for i:=1 to l do
begin
if (copy(s,i,4)=' is ')or(copy(s,i,4)=' am ') then
begin
be:=copy(s,i,3);
bl:=i;
br:=i+3;
end;
if copy(s,i,5)=' are ' then
begin
be:=copy(s,i,4);
bl:=i;
br:=i+4;
end;
end;
z:=copy(s,1,bl-1);
if (ord(z[1])>=65)and(ord(z[1])<=90) then z[1]:=chr(ord(z[1])+32);
b:=copy(s,br+1,l-br);
write(g,' ',b,' ',z,be,'!');
writeln;
end.
豬王争霸：涉及高精度的排序和累加，還可以，就是寫得ws了些。
program rq168;
type
pig=record
m:string;
da:ansistring;
end;
xx=array[0..10000] of longint;
var
n,i,kk,j,n1,n2:longint;
bb:longint;
a,b,c:xx;
p:array[0..1001] of pig;
t:pig;
ans:longint;
sum:ansistring;
procedure sort(l,r:longint);
var
i,j:longint;
m:ansistring;
t:pig;
begin
i:=l; j:=r; m:=p[(l+r) div 2].da;
repeat
while p[i].da>m do inc(i);
while m>p[j].da do dec(j);
if i<=j then
begin
t:=p[i]; p[i]:=p[j]; p[j]:=t;
inc(i); dec(j);
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
procedure cut(st:ansistring;t:longint;var d:xx);
var
tt:ansistring;l:longint;
begin
repeat
l:=length(st);
tt:=copy(st,l-7,8);
val(tt,d[t]);
dec(t);
delete(st,l-7,8);
until t=1;
val(st,d[t]);
end;
procedure add;
var
ii,jj,yy,hh:longint;
begin
if bb>490 then
begin
for ii:=1 to n do delete(p[ii].da,1,bb-490);
bb:=490;
end;
kk:=bb div 8+1;
if kk>1 then
begin
cut(p[1].da,kk,a);
for ii:=2 to n do
begin
cut(p[ii].da,kk,b);
yy:=0;
for jj:=kk downto 1 do
begin
c[jj]:=a[jj]+b[jj]+yy;
yy:=c[jj] div 100000000;
c[jj]:=c[jj] mod 100000000;
end;
for hh:=1 to kk do a[hh]:=c[hh];
if (c[kk+1]<>0)and((kk+1)*8<=490) then begin inc(kk);a[kk]:=c[kk];end;
end;
end
else for ii:=1 to n do
begin
val(p[ii].da,a[ii]);
ans:=ans+a[ii];
end;
end;
begin
readln(n);
for i:=1 to n do
begin
readln(p[i].m);readln(p[i].da);
end;
for i:=2 to n do
if length(p[i].da)>length(p[1].da) then
begin
t:=p[i]; p[i]:=p[1]; p[1]:=t;
end;
bb:=length(p[1].da);
for i:=2 to n do
while length(p[i].da)<length(p[1].da) do p[i].da:='0'+p[i].da;
sort(1,n);
repeat
j:=i;
while p[j].da=p[j-1].da do dec(j);
for n1:=j to i-1 do
for n2:=n1+1 to i do
if p[n1].m>p[n2].m then
begin
t:=p[n1];p[n1]:=p[n2];p[n2]:=t;
end;
i:=j;
dec(i);
until i=0;
for i:=1 to n do writeln(p[i].m);
add;
if ans<>0 then
begin
str(ans,sum);
for i:=1 to 490-length(sum) do
write('0');
writeln(sum);
end
else
begin
str(c[1],sum);
if kk=62 then
begin
for i:=length(sum)-1 to length(sum) do
write(sum[i]);
end
else
begin
for i:=1 to 490-length(sum)-(kk-1)*8 do
write('0');
write(sum);
end;
for i:=2 to kk do
begin
if c[i]<10000000 then write('0');
if c[i]<1000000 then write('0');
if c[i]<100000 then write('0');
if c[i]<10000 then write('0');
if c[i]<1000 then write('0');
if c[i]<100 then write('0');
if c[i]<10 then write('0');
write(c[i]);
end;
end;
end.
提示問題：比較簡單但是寫出來特别ws的字元串處理。
program rq212;
var
s,ans,f:string;
i,j,l,k,sum:integer;
b:boolean;
begin
readln(s);
ans:=s; sum:=0;
for i:=1 to length(s) do
if ((ord(s[i])>=65)and(ord(s[i])<=90))or((ord(s[i])>=97)and(ord(s[i])<=122))then
begin
ans[i]:='.';
inc(sum);
end;
writeln(ans);
l:=round(sum/3);j:=l;
for i:=1 to length(s) do
begin
if ((ord(s[i])>=65)and(ord(s[i])<=90))or((ord(s[i])>=97)and(ord(s[i])<=122))then
begin
ans[i]:=s[i];
dec(j);
end;
if j=0 then break;
end;
k:=i+1;
writeln(ans);
b:=true;
for i:=k to length(s) do
if ((ord(s[i])>=65)and(ord(s[i])<=90))or((ord(s[i])>=97)and(ord(s[i])<=122)) then
if (ord(s[i])=65)or(ord(s[i])=69)or(ord(s[i])=73)or(ord(s[i])=79)or(ord(s[i])=85)or(ord(s[i])=97)or(ord(s[i])=101)or(ord(s[i])=105)or(ord(s[i])=111)or(ord(s[i])=117) then
begin
b:=false;
ans[i]:=s[i];
end;
if b then
begin
l:=round(sum/3); j:=round((sum/3)*2)-l;
for i:=k to length(s) do
begin
if ((ord(s[i])>=65)and(ord(s[i])<=90))or((ord(s[i])>=97)and(ord(s[i])<=122)) then
begin
ans[i]:=s[i];
dec(j);
end;
if j=0 then break;
end;
end;
writeln(ans);
end.
自然的謎語：标準的KMP，于是知道今天我才學會KMP...
program rq382;
var
i,j,k,l,n:longint;
s1,s2:ansistring;
a,next:array[1..100000] of longint;
procedure main;
var i,j,l1,l2:longint;
begin
i:=1;j:=1;n:=1;
l1:=length(s1);
l2:=length(s2);
while i<=l2 do
begin
if (j=0) or (s2[i]=s1[j]) then
begin
inc(i);
inc(j);
end
else j:=next[j];
if j>l1 then
begin
a[n]:=i-j+1;
inc(n);
j:=next[j];
end;
end;
end;
begin
readln(s1);
readln(s2);
l:=length(s1);
j:=1;
k:=0;
while j<=l do
begin
if (k=0) or (s1[j]=s1[k]) then
begin
inc(j);
inc(k);
next[j]:=k;
end
else
k:=next[k];
end;
main;
dec(n);
if n=0 then
write('There must be something wrong.')
else
begin
writeln(n);
for i:=1 to n do
writeln(a[i]);
end;
end.
掃雷：額，簡單模拟，輸出即可。
program rq484;
var
m,n,i,j,x:longint;
a:Array[0..101,0..101]of char;
ans:array[1..100,1..100]of longint;
function calc(i,j:longint):longint;
begin
calc:=0;
if a[i-1,j]='*'then inc(calc);
if a[i-1,j-1]='*'then inc(calc);
if a[i-1,j+1]='*'then inc(calc);
if a[i+1,j]='*'then inc(calc);
if a[i+1,j-1]='*'then inc(calc);
if a[i+1,j+1]='*'then inc(calc);
if a[i,j-1]='*'then inc(calc);
if a[i,j+1]='*'then inc(calc);
end;
begin
readln(n,m);
x:=0;
while m*n<>0 do
begin
inc(x);
for i:=1 to n do
begin
for j:=1 to m do
read(a[i,j]);
readln;
end;
for i:=1 to n do
for j:=1 to m do
if a[i,j]='.' then ans[i,j]:=calc(i,j);
writeln('Field #',x,':');
for i:=1 to n do
begin
for j:=1 to m do
if a[i,j]='*'then write('*')else
write(ans[i,j]);
writeln;
end;
readln(n,m);
if m*n<>0 then
writeln;
end;
end.
Fish學數學：标準的歸并排序，排的時候就統計處逆序對數了。
program rq173;
var
i,n,ans:longint;
a:array[1..20000]of longint;
procedure merge(l,x,r:integer);
var
i,j,p:integer;
b:array[1..20000]of longint;
begin
i:=l; j:=x+1; p:=l;
while p<=r do
begin
if (i<=x)and((j>r)or(a[i]<=a[j])) then
begin
b[p]:=a[i]; inc(i);
end
else
begin
b[p]:=a[j]; inc(j);
ans:=ans+x-i+1;
end;
inc(p);
end;
for i:=l to r do a[i]:=b[i];
end;
procedure msort(l,r:integer);
var x:integer;
begin
if l<>r then
begin
x:=(l+r) div 2;
msort(l,x);
msort(x+1,r);
merge(l,x,r);
end;
end;
begin
readln(n);
for i:=1 to n do read(a[i]);
ans:=0;
msort(1,n);
writeln(ans);
end.
啊啊寫完了，今天要早點睡了。
2010年10月23日23:02:16
![在DOS下運作不了ipconfig指令[圖]](data:image/gif;base64,R0lGODlhAQABAIAAAP///wAAACwAAAAAAQABAAACAkQBADs=)