USACO chapter1
几天时间就把USACO chapter1重新做了一遍，发现了自己以前许多的不足。蒽，现在的程序明显比以前干净很多，而且效率也提高了许多。继续努力吧，好好的提高自己。这一章主要还是基本功的训练，没多少的思维难度，不过基础也是很重要的。
——2013年11月17日
1.1.1 Your Ride Is Here
题目很简单，长字符串读入，按位相乘，同时取模即可，一开始的时候居然忘记了给d1和d2赋值1，结果无论是什么字符串读入计算结果都为0，虽然是水题，还是要记住初始化！
{ID: jiangyi10
PROG: ride
LANG: PASCAL
}
var
d1,d2,i,j,k,l,m,n:longint;
s:ansistring;
{file}
procedure openf;
begin
assign(input,'ride.in'); reset(input);
assign(output,'ride.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{input}
openf;
{zero}
d1:=;
d2:=;
{doit}
readln(s);
for i:= to length(s) do
d1:=d1*(ord(s[i])-ord('A')+) mod ;
readln(s);
for i:= to length(s) do
d2:=d2*(ord(s[i])-ord('A')+) mod ;
{output}
if d1=d2 then writeln('GO') else writeln('STAY');
closef;
end.
1.1.2 Greedy Gift Givers
暴力很容易想到，只要每次读入字符串之后循环找到其在字符串数组中的位置即可进行操作，优化的话加入链表hash即可，但是最后经过测试在USACO中暴力也可过，所以略有郁闷。
{
ID: jiangyi10
PROG: gift1
LANG: PASCAL
}
var
now,i,j,k,l,m,n,ave:longint;
s:array[..] of ansistring;
amount,ans:array[..] of longint;
{file}
procedure openf;
begin
assign(input,'gift1.in'); reset(input);
assign(output,'gift1.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{openf}
openf;
readln(n);
for i:= to n do
readln(s[i]);
{doit}
for i:= to n do
begin
readln(s[]);
readln(now,k);
if k<> then ave:=now div k;
for j:= to n do
if s[j]=s[] then break;
amount[j]:=now;
if k= then inc(ans[j],now)
else inc(ans[j],now mod k);
for j:= to k do
begin
readln(s[]);
for l:= to n do
if s[l]=s[] then break;
inc(ans[l],ave);
end;
end;
{output}
for i:= to n do
writeln(s[i],' ',ans[i]-amount[i]);
closef;
end.
1
{
ID: jiangyi10
PROG: gift1
LANG: PASCAL
}
const
modnum=;
type
link=^node;
node=record
t:longint;
next:link;
end;
var
top,ave,i,j,k,l,m,n,t,mo:Longint;
a:array[..] of ansistring;
exl:array[..modnum-] of link;
st,en:array[..] of longint;
s:ansistring;
{file}
procedure openf;
begin
assign(input,'gift1.in'); reset(input);
assign(output,'gift1.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{hash}
function bkdrhash(s:string):longint;
var
i:longint;
ans:int64;
begin
ans:=;
for i:= to length(s) do
ans:=((ans<<)+ord(s[i])) and ($FFFFFFF);
ans:=ans mod modnum;
exit(ans);
end;
{find}
function find(s:string):longint;
var
i,j,hash:longint;
w:link;
begin
hash:=bkdrhash(s);
new(w);
w:=exl[hash];
if w=nil then exit();
while (a[w^.t]<>s)and(w^.next<>nil) do w:=w^.next;
if a[w^.t]=s then exit(w^.t)
else exit();
end;
{add}
function add(s:string):longint;
var
w:link;
t,hash,i,j:longint;
begin
hash:=bkdrhash(s);
t:=find(s);
if t<> then exit(t)
else begin
new(w);
inc(top);
a[top]:=s;
w^.t:=top;
w^.next:=exl[hash];
exl[hash]:=w;
exit(top);
end;
end;
begin
{input}
openf;
readln(n);
for i:= to n do
begin
readln(s);
t:=add(s);
end;
{doit}
for i:= to n do
begin
readln(s);
k:=find(s);
readln(st[k],mo);
if mo= then
inc(en[k],st[k])
else begin
ave:=st[k] div mo;
inc(en[k],st[k] mod mo);
for j:= to mo do
begin
readln(s);
l:=find(s);
inc(en[l],ave);
end;
end;
end;
{output}
for i:= to n do
writeln(a[i],' ',en[i]-st[i]);
closef;
end.
2
1.1.3 Friday the Thirteenth
这道题主要考察蔡勒公式，一点意思都没有，注意13月14月代指1,2月，不过呢这道题告诉我重要的一点就是在取模的时候要进行加模后再取模，这样就不会导致负数取模的错误情况。
{ID: jiangyi10
PROG: friday
LANG: PASCAL
}
var
i,j,k,l,m,n:longint;
year,month,day,date,century:longint;
ans:array[..] of longint;
{file}
procedure openf;
begin
assign(input,'friday.in'); reset(input);
assign(output,'friday.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{getnum}
function w(year,month,century:longint):longint;
begin
w:=((year+(year div )+(century div )-*century+(*(month+)div )+)+) mod ;
end;
begin
{input}
openf;
readln(n);
{doit}
for i:= to n- do
begin
century:=;
year:=i;
while year>= do
begin
dec(year,);
inc(century);
end;
for month:= to do
inc(ans[w(year,month,century)]);
dec(year);
if year< then begin
inc(year,);
dec(century);
end;
for month:= to do
inc(ans[w(year,month,century)]);
end;
{output}
write(ans[],' ',ans[]);
for i:= to do
write(' ',ans[i]);
writeln;
closef;
end.
1.1.4 Broken Necklace
首先，这道题目只要对每一个点向前搜索和向后搜索，将两次搜索之和相加即可，然后就过了，但是当数据扩大，连续相同的珠子增多时，这种方法就产生了许多的计算冗余，所以一开始在读入时就可以进行分块处理，将相同颜色的珠子直接分为一块，然后对块进行搜索即可，预计效率可以提高不少。
{ID: jiangyi10
PROG: beads
LANG: PASCAL
}
var
max,i,j,k,l,m,n,behindlength,beforelength:longint;
s:array[..] of char;
nowcolor:char;
procedure openf;
begin
assign(input,'beads.in'); reset(input);
assign(output,'beads.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
procedure searchbehind(x:longint);
begin
if behindlength>n then exit;
if behindlength= then nowcolor:=s[x];
if (nowcolor<>s[x])and(s[x]<>'w')then exit
else inc(behindlength);
if x+<=n then
searchbehind(x+)
else searchbehind();
end;
procedure searchbefore(x:longint);
begin
if beforelength>n then exit;
if beforelength= then nowcolor:=s[x];
if nowcolor='w' then nowcolor:=s[x];
if(nowcolor<>s[x])and(s[x]<>'w') then exit
else inc(beforelength);
if x-> then
searchbefore(x-)
else searchbefore(n);
end;
begin
openf;
readln(n);
max:=;
for i:= to n do
read(s[i]);
for i:= to n do
begin
behindlength:=;
searchbehind(i);
beforelength:=;
if i-> then
searchbefore(i-)
else searchbefore(n);
if beforelength+behindlength>n then begin
writeln(n);
closef;
end
else if beforelength+behindlength>max then max:=beforelength+behindlength;
end;
writeln(max);
closef;
end.
1
{ID: jiangyi10
PROG: beads
LANG: PASCAL
}
var
nowcolor,behindlength,beforelength,tmp,max,i,j,k,l,m,n,top,flag:longint;
a:array[..] of char;
block,color:array[..] of longint;
{file}
procedure openf;
begin
assign(input,'beads.in'); reset(input);
assign(output,'beads.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{search}
procedure searchbehind(x:longint);
begin
if behindlength>n then exit;
if behindlength= then nowcolor:=color[x];
if (nowcolor<>color[x])and(color[x]<>)then exit
else inc(behindlength,block[x]);
if x+<=top then
searchbehind(x+)
else searchbehind();
end;
procedure searchbefore(x:longint);
begin
if beforelength>n then exit;
if beforelength= then nowcolor:=color[x];
if nowcolor= then nowcolor:=color[x];
if(nowcolor<>color[x])and(color[x]<>) then exit
else inc(beforelength,block[x]);
if x-> then
searchbefore(x-)
else searchbefore(top);
end;
begin
{input}
openf;
readln(n);
flag:=;
read(a[]);
for i:= to n do begin
read(a[i]);
if a[i]<>a[i-] then
begin
inc(top);
block[top]:=i--flag;
flag:=i-;
if a[i-]='b' then color[top]:=;
if a[i-]='r' then color[top]:=;
end;
end;
inc(top);
block[top]:=n-flag;
if a[n]='b' then color[top]:=;
if a[n]='r' then color[top]:=;
{special}
if top= then
begin
writeln(n);
closef;
end;
{doit}
if color[top]=color[] then
begin
inc(block[],block[top]);
dec(top);
end;
for i:= to top do
begin
behindlength:=;
searchbehind(i);
beforelength:=;
if i-> then
searchbefore(i-)
else searchbefore(top);
if behindlength+beforelength>max then max:=behindlength+beforelength;
end;
{output}
if max>n then writeln(n)
else writeln(max);
closef;
end.
2
1.2.1 Milking Cows
这一题还是很裸的暴力，读入每一个区间，将其按照左端点排序，合并并去重，操作过程中同时统计两个答案，然后就可以AC了。
{ID: jiangyi10
PROG: milk2
LANG: PASCAL
}
var
pre,ans1,ans2,k1,k2,flag,i,j,k,l,m,n:longint;
st,en:array[..] of longint;
{file}
procedure openf;
begin
assign(input,'milk2.in'); reset(input);
assign(output,'milk2.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{sort}
procedure qsort(l,r:longint);
var
i,j,mid,t:longint;
begin
i:=l; j:=r;
mid:=st[l+random(r-l+)];
repeat
while st[i]<mid do inc(i);
while st[j]>mid do dec(j);
if i<=j then
begin
t:=st[i];
st[i]:=st[j];
st[j]:=t;
t:=en[i];
en[i]:=en[j];
en[j]:=t;
inc(i); dec(j);
end;
until i>j;
if i<r then qsort(i,r);
if j>l then qsort(l,j);
end;
begin
{input}
openf;
readln(n);
for i:= to n do
readln(st[i],en[i]);
{doit}
randomize;
qsort(,n);
k1:=st[];
k2:=en[];
ans1:=k2-k1;
for i:= to n do
begin
if (st[i]<=k2)and(en[i]>k2) then k2:=en[i];
if st[i]>k2 then begin
if k2-k1>ans1 then ans1:=k2-k1;
if st[i]-k2>ans2 then ans2:=st[i]-k2;
k1:=st[i]; k2:=en[i];
end;
end;
{output}
writeln(ans1,' ',ans2);
closef;
end.
1.2.2 Transformations
这一题如果去判断要用哪一种方法去实现，就会变得比较困难，那么正难则反，每一种判断是否可行，也就是发现其不可行直接不考虑，最后哪种没有被删去就是这种了。
{ID: jiangyi10
PROG: transform
LANG: PASCAL
}
var
i,j,k,l,m,n:longint;
c:array[..] of boolean;
a,b,d:array[..,..] of char;
{file}
procedure openf;
begin
assign(input,'transform.in'); reset(input);
assign(output,'transform.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{input}
openf;
fillchar(c,sizeof(c),true);
readln(n);
for i:= to n do
begin
for j:= to n do
read(a[i,j]);
readln;
end;
for i:= to n do
begin
for j:= to n do
read(b[i,j]);
readln;
end;
{doit}
for i:= to n do
for j:= to n do
begin
if a[i,j]<>b[i,j] then c[]:=false;
if a[i,j]<>b[j,n-i+] then c[]:=false;
if a[i,j]<>b[n-i+,n-j+] then c[]:=false;
if a[i,j]<>b[n-j+,i] then c[]:=false;
if a[i,j]<>b[i,n-j+] then c[]:=false;
end;
if c[] then writeln('')
else if c[] then writeln('')
else if c[] then writeln('')
else if c[] then writeln('')
else if c[] then writeln('')
else begin
fillchar(c,sizeof(c),);
for i:= to n do
for j:= to n do
d[i,j]:=a[i,n-j+];
for i:= to n do
for j:= to n do
begin
if d[i,j]<>b[j,n-i+] then c[]:=false;
if d[i,j]<>b[n-i+,n-j+] then c[]:=false;
if d[i,j]<>b[n-j+,i] then c[]:=false;
end;
if c[] or c[] or c[] then writeln('')
else writeln('');
end;
closef;
end.
1.2.3 Name That Number
对于一开始给出的姓名文件，我们先将其保存下来，并重新建立一个数组记录下它的数字。之后读入姓名编号之后再这个数组之中寻找这个数字，每找到一个便输出。
{ID: jiangyi10
PROG:namenum
LANG: PASCAL
}
var
i,j,k,l,m:longint;
n:int64;
c:char;
s:array[..] of string;
a:array[..] of int64;
r:longint;
bo:boolean;
{file}
procedure openf;
begin
assign(input,'namenum.in'); reset(input);
assign(output,'namenum.out'); rewrite(output);
end;
procedure closef;
begin
close(input);
close(output);
halt;
end;
{mi}
function mi(a,b:int64):int64;
var
t,y:int64;
begin
t:=; y:=a;
while b<> do
begin
if (b and )= then t:=t*y;
y:=y*y;
b:=b shr ;
end; exit(t);
end;
begin
{input}
bo:=false;
assign(input,'dict.txt'); reset(input);
for i:= to do
begin
readln(s[i]);
for j:= to length(s[i]) do
begin
if (s[i][j]='A')or(s[i][j]='B')or(s[i][j]='C')then r:=
else if (s[i][j]='D')or(s[i][j]='F')or(s[i][j]='E')then r:=
else if (s[i][j]='G')or(s[i][j]='H')or(s[i][j]='I')then r:=
else if (s[i][j]='J')or(s[i][j]='K')or(s[i][j]='L')then r:=
else if (s[i][j]='M')or(s[i][j]='N')or(s[i][j]='O')then r:=
else if (s[i][j]='P')or(s[i][j]='R')or(s[i][j]='S')then r:=
else if (s[i][j]='T')or(s[i][j]='U')or(s[i][j]='V')then r:=
else if (s[i][j]='W')or(s[i][j]='X')or(s[i][j]='Y')then r:=;
a[i]:=r*mi(,length(s[i])-j)+a[i];
end;
end;
close(input);
openf;
readln(n);
{output}
for i:= to do
if a[i]=n then
begin
bo:=true;
k:=i;
break;
end;
if not bo then writeln('NONE')
else for i:=k to do
begin
if a[i]=n then
writeln(s[i]);
end;
closef;
end.
1.2.4 Palindromic Squares
对于这道题目，枚举1至300，同时计算出平方的进制，判断是否是回文，是则生成那个进制数并输出。在字符串转化时有一个神奇的处理方法，就是定义一个常量字符s=‘0123456789ABCDEFGHIJKLMN’在进制转化时直接取模在s中取位即可。
{ID: jiangyi10
PROG: palsquare
LANG: PASCAL
}
var
i,j,k,l,m,n,o:longint;
a,b:array[..] of char;
s:string;
bo:boolean;
{file}
procedure openf;
begin
assign(input,'palsquare.in'); reset(input);
assign(output,'palsquare.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{input}
openf;
readln(n);
{doit}
s:='0123456789ABCDEFGHIJKL';
for i:= to do
begin
bo:=true;
j:=i*i;
k:=;
o:=;
while j<> do
begin
inc(k);
a[k]:=s[j mod n+];
j:=j div n;
end;
for j:= to k do
if a[j]<>a[k-j+]
then bo:=false;
if bo then
begin
m:=i;
while m<> do
begin
inc(o);
b[o]:=s[m mod n+];
m:=m div n;
end;
for j:=o downto do
write(b[j]);
write(' ');
for j:= to k do
write(a[j]);
writeln;
end;
end;
closef;
end.
1.2.5 Dual Palindromes
欣喜地发现这道题和上一道题是一模一样的方法，只要用字符串处理法就可以轻松解决进制转化，剩下的就是模拟了。
{ID: jiangyi10
PROG:dualpal
LANG: PASCAL
}
var
i,j,k,l,m,n,o,p:longint;
a:array[..] of char;
s:string;
bo:boolean;
{openf}
procedure openf;
begin
assign(input,'dualpal.in'); reset(input);
assign(output,'dualpal.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{input}
openf;
readln(n,m);
s:='0123456789ABCDEFGHIJKL';
{doit}
while n<> do
begin
inc(m);
o:=;
for i:= to do
begin
k:=m;
j:=;
while k<> do
begin
inc(j);
a[j]:=s[k mod i+];
k:=k div i;
end;
bo:=true;
for l:= to j do
if a[l]<>a[j-l+] then bo:=false;
if bo then inc(o);
if o>= then begin
writeln(m); dec(n);
break;
end;
end;
end;
closef;
end.
1.3.1 Mixing Milk
一开始看到题目以为是DP的背包，但是仔细一看，这原来只是一道非常简单的贪心，将数据按照价值排序，从小到大进行处理，最后输出答案即可。
{ID: jiangyi10
PROG:milk
LANG: PASCAL
}
var
ans,i,j,k,l,m,n:longint;
v,w:array[..] of longint;
{file}
procedure openf;
begin
assign(input,'milk.in'); reset(input);
assign(output,'milk.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{sort}
procedure qsort(l,r:longint);
var
i,j,mid,t:longint;
begin
i:=l; j:=r;
mid:=v[l+random(r-l+)];
repeat
while v[i]<mid do inc(i);
while v[j]>mid do dec(j);
if i<=j then
begin
t:=v[i];
v[i]:=v[j];
v[j]:=t;
t:=w[i];
w[i]:=w[j];
w[j]:=t;
inc(i); dec(j);
end;
until i>j;
if i<r then qsort(i,r);
if l<j then qsort(l,j);
end;
begin
{input}
openf;
readln(n,m);
for i:= to m do
readln(v[i],w[i]);
randomize;
qsort(,m);
{doit}
i:=;
repeat
inc(i);
if w[i]<n then begin
dec(n,w[i]);
inc(ans,w[i]*v[i]);
end
else begin
inc(ans,n*v[i]);
n:=;
end;
until n=;
{output}
writeln(ans);
closef;
end.
1.3.2
首先根据题目，需要找M块木板，使得其盖住所有有牛的牛棚，所以呢，我们只需关心有牛的牛棚，牛棚总数对于题目没有任何的影响，但是这几块木板怎么找呢，看起来很困难，但是把题目转化一下，求M-1个牛棚之间的空缺，那么就很简单了，快排牛的位置，用最大值减去最小值加1作为答案的初始值，然后对于每两个牛的位置求差，将差排序，从最大开始从答案中减去，最后就得到答案了。需要注意的是当木板的个数大于牛棚（有牛的）个数时，直接输出牛棚个数，一开始没考虑这种特殊情况，结果导致输出了极大的负数，要引以为戒啊。
{ID: jiangyi10
PROG:barn1
LANG: PASCAL
}
var
sum,i,j,k,l,m,n:longint;
a,b:array[..] of longint;
{file}
procedure openf;
begin
assign(input,'barn1.in'); reset(input);
assign(output,'barn1.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{sort}
procedure qsort(l,r:longint);
var
i,j,mid,t:longint;
begin
i:=l; j:=r;
mid:=a[l+random(r-l+)];
repeat
while a[i]<mid do inc(i);
while a[j]>mid do dec(j);
if i<=j then begin
t:=a[i];
a[i]:=a[j];
a[j]:=t;
inc(i); dec(j);
end;
until i>j;
if i<r then qsort(i,r);
if l<j then qsort(l,j);
end;
begin
{input}
openf;
readln(k,m,n);
if k>n then begin
writeln(n);
closef;
end;
for i:= to n do
readln(a[i]);
{doit}
randomize;
qsort(,n);
sum:=a[n]-a[]+;
for i:= to n- do
a[i]:=a[i+]-a[i];
qsort(,n-);
for i:=n- downto n-k+ do
dec(sum,a[i]-);
{output}
writeln(sum);
closef;
end.
1.3.3 Calf Flac
这道题思路还是比较清晰的，分奇数串和偶数串讨论，不用删去标点，直接在上面做，遇到标点跳过即可，主要掌握枚举单个点之后向外扩展的思想即可，不过比较坑的地方是输出，特别是计入换行符插入的地方，输出时注意一下。
{ID: jiangyi10
PROG:calfflac
LANG: PASCAL
}
var
ans,i,j,k,l,r,m,n,al,ar,nowl,nowr,temp:longint;
t,s:ansistring;
bo:boolean;
huanhang:array[..] of boolean;
{file}
procedure openf;
begin
assign(input,'calfflac.in'); reset(input);
assign(output,'calfflac.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{input}
openf;
readln(s);
huanhang[length(s)] := true;
while not eof do
begin
readln(t);
s := s + t;
huanhang[length(s)] := true;
end;
{doit}
s := s + ',.!@#';
n:=length(s);
for i:= to length(s) do
begin
l:=i; r:=i; bo:=true;
temp:=-;
repeat
if (l>=)and(r<=n) then
begin
al:=;
ar:=;
while (al=)and(l>) do
begin
if s[l] in ['a'..'z'] then begin
al:=ord(s[l])-ord('a')+;inc(temp);
end
else if s[l] in['A'..'Z'] then begin al:=ord(s[l])-ord('A')+;inc(temp);end
else dec(l);
end;
while (ar=)and(r<n) do
begin
if s[r] in ['a'..'z'] then begin
ar:=ord(s[r])-ord('a')+;inc(temp);end
else if s[r] in ['A'..'Z'] then begin ar:=ord(s[r])-ord('A')+;inc(temp);end
else inc(r);
end;
if al=ar then
begin
if ans<(temp) THEN
begin ANS:=temp; nowl:=l; nowr:=r;
end;
end
else bo:=false;
end;
dec(l); inc(r);
if (l<) or (r>n) then bo:=false;
until bo=false;
l:=i; r:=i+; bo:=true;
temp := ;
repeat
if (l>=)and(r<=n) then
begin
al:=;
ar:=;
while (al=)and(l>) do
begin
if s[l] in ['a'..'z'] then begin al:=ord(s[l])-ord('a')+;inc(temp);end
else if s[l] in['A'..'Z'] then begin al:=ord(s[l])-ord('A')+;inc(temp);end
else dec(l);
end;
while (ar=)and(r<n) do
begin
if s[r] in ['a'..'z'] then begin ar:=ord(s[r])-ord('a')+;inc(temp);end
else if s[r] in ['A'..'Z'] then begin ar:=ord(s[r])-ord('A')+;inc(temp);end
else inc(r);
end;
if al=ar then begin
if ans<(temp) THEN
begin ANS:=temp; nowr:=r; nowl:=l; end;end
else bo:=false;
end;
dec(l); inc(r);
if (l<) or (r>n) then bo:=false;
until bo=false;
end;
writeln(ans);
{output}
for i:=nowl to nowr do
begin
write(s[i]);
if huanhang[i] then writeln;
end;
if huanhang[nowr] = false then writeln;
closef;
end.
1.3.4 Prime Cryptarithm
直接模拟牛式的计算过程，然后判断是否可行，判断可以用集合（set），看计算出的数字是否在集合内。
{ID: jiangyi10
PROG:crypt1
LANG: PASCAL
}
var
se:set of ..;
a:array[..] of longint;
ans,a1,a2,a3,a4,x,a5,i,j,k,l,n:longint;
s1,s5:array[..] of longint;
s2:array[..] of longint;
s3,s4:array[..] of longint;
bo:boolean;
{file}
procedure openf;
begin
assign(input,'crypt1.in'); reset(input);
assign(output,'crypt1.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{input}
openf;
readln(n);
se:=[];
for i:= to n do
begin
read(a[i]);
se:=se+[a[i]];
end;
{doit}
for a1:= to n do
for a2:= to n do
for a3:= to n do
for a4:= to n do
for a5:= to n do
begin
s1[]:=a[a1]; s1[]:=a[a2];
s1[]:=a[a3]; s2[]:=a[a4];
s2[]:=a[a5];
if (s2[]*s1[]>=)or(s2[]*s1[]>=) then continue
else if(s2[]*s1[]+(s2[]*s1[])div >=)or(s2[]*s1[]+(s2[]*s1[])div >=)then continue
else begin
bo:=true;
x:=;
s3[]:=s1[]*s2[];
x:=s3[] div ;
s3[]:=s3[] mod ;
s3[]:=s1[]*s2[]+x;
x:=s3[] div ;
s3[]:=s3[] mod ;
s3[]:=s1[]*s2[]+x;
x:=;
s4[]:=s1[]*s2[];
x:=s4[] div ;
s4[]:=s4[] mod ;
s4[]:=s1[]*s2[]+x;
x:=s4[] div ;
s4[]:=s4[] mod ;
s4[]:=s1[]*s2[]+x;
x:=;
s5[]:=s3[];
s5[]:=s3[]+s4[];
x:=s5[] div ;
s5[]:=s5[] mod ;
s5[]:=s3[]+s4[]+x;
x:=s5[] div ;
s5[]:=s5[] mod ;
s5[]:=s4[]+x;
for i:= to do
begin
if(not (s3[i] in se)) then bo:=false;
if(not (s4[i] in se)) then bo:=false;
if(not (s5[i] in se)) then bo:=false;
end;
if not(s5[] in se) then bo:=false;
if bo then inc(ans);
end;
end;
{output}
writeln(ans);
closef;
end.
1.4.1 Packing Rectangles
一年前不会，现在依然没有思路，的的确确是模拟但就是分不清情况，只好先跳过，真伤心。
1.4.2 The Clocks
将钟的时间抽象为0，1，2，3，直接顺序枚举，加上操作产生值并对4取模，发现所有钟的值为0则方案可行，但是注意每一个指令最多只能执行3次，4次等于没执行，当发现有种方案可行就直接输出，因为是顺序枚举，所以一定是字典序最小的。
{ID: jiangyi10
PROG:clocks
LANG: PASCAL
}
const
a1:array[..,..] of longint=((,,,,,),
(,,,,,),(,,,,,),(,,,,,),(,,,,,),
(,,,,,),(,,,,,),(,,,,,),(,,,,,));
var
bo:boolean;
i,j,k,l,m,n:longint;
a,c,q:array[..] of longint;
b:array[..] of longint;
q1,q2,q3,q4,q5,q6,q7,q8,q9:longint;
{file}
procedure openf;
begin
assign(input,'clocks.in'); reset(input);
assign(output,'clocks.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
begin
{input}
openf;
for i:= to do
begin
read(k);
if k= then a[i]:=
else if k= then a[i]:=
else if k= then a[i]:=
else a[i]:=;
end;
{doit}
for q1:= to do
for q2:= to do
for q3:= to do
for q4:= to do
for q5:= to do
for q6:= to do
for q7:= to do
for q8:= to do
for q9:= to do
begin
bo:=true;
for i:= to do
c[i]:=a[i];
q[]:=q1;
q[]:=q2;
q[]:=q3;
q[]:=q4;
q[]:=q5;
q[]:=q6;
q[]:=q7;
q[]:=q8;
q[]:=q9;
for i:= to do
while q[i]> do
begin
for j:= to a1[i,] do
inc(c[a1[i,j]]);
dec(q[i]);
end;
for i:= to do
if c[i] mod <> then bo:=false;
q[]:=q1;
q[]:=q2;
q[]:=q3;
q[]:=q4;
q[]:=q5;
q[]:=q6;
q[]:=q7;
q[]:=q8;
q[]:=q9;
if bo then
begin
if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end
else if (q[]<>) and bo then begin write(); dec(q[]); end;
for i:= to q[] do write(' ',);
if q[]<> then for i:= to q2 do write(' ',);
if q[]<> then for i:= to q3 do write(' ',);
if q[]<> then for i:= to q4 do write(' ',);
if q[]<> then for i:= to q5 do write(' ',);
if q[]<> then for i:= to q6 do write(' ',);
if q[]<> then for i:= to q7 do write(' ',);
if q[]<> then for i:= to q8 do write(' ',);
if q[]<> then for i:= to q9 do write(' ',);
writeln;
closef;
end;
end;
end.
1.4.3 Arithmetic Progressions
直接暴力枚举每一种情况就可以了，不过需要排序剪枝一下，总的来说没什么技巧性。
{ID: jiangyi10
PROG:ariprog
LANG: PASCAL
}
var
b:array[..]of boolean;
a:array[..]of longint;
p,i,j,k,m,n,tot,l:longint;
ok,bo:boolean;
{file}
procedure openf;
begin
assign(input,'ariprog.in'); reset(input);
assign(output,'ariprog.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{sort}
procedure qsort(l,r:longint);
var
i,j,t,mid:longint;
begin
i:=l; j:=r;
mid:=a[l+random(r-l+)];
repeat
while a[i]<mid do inc(i);
while a[j]>mid do dec(j);
if i<=j then begin
t:=a[i];
a[i]:=a[j];
a[j]:=t;
inc(i); dec(j);
end;
until i>j;
if i<r then qsort(i,r);
if l<j then qsort(l,j);
end;
{check}
function check(x,y:longint):boolean;
var
i,m:longint;
begin
m:=x;
for i:= to n- do
begin
inc(m,y);
if not b[m] then exit(false);
end;
exit(true);
end;
begin
{input}
openf;
read(n,m);
{doit}
for i:= to m do
for j:=i to m do
begin
if not b[i*i+j*j] then
begin
inc(tot);
a[tot]:=i*i+j*j;
b[a[tot]]:=true;
end;
end;
randomize;
qsort(,tot);
l:=*m*m;
for i:= to *m*m div (n-) do
begin
k:=(n-)*i;
for j:= to tot do
begin
if a[j]+k>l then break;
if check(a[j],i) then begin
bo:=true;
writeln(a[j],' ',i);
end;
end;
end;
if not bo then writeln('NONE');
closef;
end.
1.4.4 Mother's Milk
很纯粹的模拟，对于每一种情况讨论一下，然后深搜求解，对于搜过的情况，用三维数组标记，减少搜索量。
{ID: jiangyi10
PROG:milk3
LANG: PASCAL
}
var
va,vb,vc,na,nb,nc,i,j,k,l,m,n:longint;
ans:array[..] of boolean;
v:array[..,..,..] of boolean;
{file}
procedure openf;
begin
assign(input,'milk3.in'); reset(input);
assign(output,'milk3.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{search}
procedure search(na,nb,nc:longint);
begin
if v[na,nb,nc] then exit else v[na,nb,nc]:=true;
if na = then ans[nc]:=true;
if (na>)and(na+nb>vb) then search(na-(vb-nb),vb,nc);
if (na>)and(na+nb<=vb) then search(,na+nb,nc);
if (nb>)and(nb+na>va) then search(va,nb-(va-na),nc);
if (nb>)and(nb+na<=va) then search(na+nb,,nc);
if (nb>)and(nb+nc>vc) then search(na,nb-(vc-nc),vc);
if (nb>)and(nb+nc<=vc) then search(na,,nb+nc);
if (nc>)and(nc+nb>vb) then search(na,vb,nc-(vb-nb));
if (nc>)and(nc+nb<=vb) then search(na,nb+nc,);
if (nc>)and(nc+na>va) then search(va,nb,nc-(va-na));
if (nc>)and(nc+na<=va) then search(nc+na,nb,);
if (na>)and(na+nc>vc) then search(na-(vc-nc),nb,vc);
if (na>)and(na+nc<=vc) then search(na+nc,nb,);
end;
begin
{input}
openf;
readln(va,vb,vc);
{doit}
nc:=vc;
search(na,nb,nc);
ans[vc]:=true;
for i:= to do
if ans[i] then break;
n:=i; write(i);
for i:=n+ to do
{output}
if ans[i] then write(' ',i);
writeln;
closef;
end.
1.5.1 Number Triangles
简单的模拟，直接由下往上递推，选取下面最大值累加至上一层，最后输出第一层就是答案了。
{ID: jiangyi10
PROG:numtri
LANG: PASCAL
}
var
i,j,k,l,m,n:longint;
a:array[..,..] of longint;
{file}
procedure openf;
begin
assign(input,'numtri.in'); reset(input);
assign(output,'numtri.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{max}
function max(q,w:longint):longint;
begin
if q>w then exit(q)
else exit(w);
end;
begin
{input}
openf;
readln(n);
for i:= to n do
for j:= to i do
read(a[i,j]);
{doit}
for i:=n- downto do
for j:= to i do
inc(a[i,j],max(a[i+,j],a[i+,j+]));
{output}
writeln(a[,]);
closef;
end.
1.5.2 Prime Palindromes
先生成范围内的回文数，之后再判断是否是素数即可，有一个神奇的发现，因为是奇数，所以Miller算法只要判断7和61即可全过，不过保险一点还是加上一些随机。
{ID: jiangyi10
PROG:pprime
LANG: PASCAL
}
var
i,j,k,l:longint;
w,m,n,ans:int64;
{file}
procedure openf;
begin
assign(input,'pprime.in'); reset(input);
assign(output,'pprime.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{power}
function power(a,b,m:int64):int64;
var
y,t:int64;
begin
t:=;
y:=a;
while b<> do
begin
if b and = then t:=(t*y) mod m;
y:=y*y mod m;
b:=b shr ;
end;
exit(t);
end;
{miller}
function pan(t:int64):boolean;
var
i:longint;
begin
for i:= to do begin
w:=random(t-)+;
if power(w,t-,t)<> then exit(false);
end;
if power(,t-,t)<> then exit(false);
if power(,t-,t)<> then exit(false);
if power(,t-,t)<> then exit(false);
exit(true);
end;
begin
{input}
openf;
readln(m,n);
randomize;
{special}
if (m<=) and (n>=) then writeln('');
if (m<=) and (n>=) then writeln('');
if (m<=) and (n>=) then writeln('');
{}
for i:= to do
for j:= to do
if odd(i) then
begin
ans:=i*+j*+i;
if (ans<m) or (ans>n)then continue;
if pan(ans) then writeln(ans);
end;
{}
for i:= to do
for j:= to do
for k:= to do
if odd(i) then
begin
ans:=i*+j*+k*+j*+i;
if (ans<m) or (ans>n) then continue;
if pan(ans) then writeln(ans);
end;
{}
for i:= to do
for j:= to do
for k:= to do
for l:= to do
if odd(i) then
begin
ans:=i*+j*+k*+l*+k*+j*+i;
if (ans<m) or (ans>n) then continue;
if pan(ans) then writeln(ans);
end;
closef;
end.
1.5.3 Superprime Rib
由于每一步都要是质数，所以这个数一定由1,3,7,9组成，所以直接搜索这四个数就可以了，关于素数判定同上题，Miller只要7和61就可以全过。
{ID: jiangyi10
PROG:sprime
LANG: PASCAL
}
const
a:array[..] of longint=(,,,);
var
ans,i,j,k,l,m,n:longint;
{file}
procedure openf;
begin
assign(input,'sprime.in'); reset(input);
assign(output,'sprime.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{power}
function power(a,b,m:int64):int64;
var
y,t:int64;
begin
t:=;
y:=a;
while b<> do
begin
if b and = then t:=(t*y) mod m;
y:=y*y mod m;
b:=b shr ;
end;
exit(t);
end;
{miller}
function pan(t:int64):boolean;
var
i:longint;
begin
if power(,t-,t)<> then exit(false);
if power(,t-,t)<> then exit(false);
exit(true);
end;
{search}
procedure search(m,x:longint);
var
i,j,k,l:longint;
begin
if x=n then begin
writeln(m);
exit;
end;
for i:= to do
begin
ans:=m*+a[i];
if pan(ans) then search(ans,x+);
end;
end;
begin
{input}
openf;
readln(n);
{special}
if n= then begin
writeln();
writeln();
writeln();
writeln();
end;
{doit}
if n>= then begin
search(,);
search(,);
search(,);
search(,);
end;
closef;
end.
1.5.4 checker
对于方案输出，可以直接搜索，像一般的八皇后问题一样，但是对于方案数，这样肯定会超时，所以，要用上位运算来优化，Martrix神牛的方法不管什么时候看都还是那么高级，用了位运算，巧妙地利用了搜索的有序性来加速，比dancinglink快多了。
{ID: jiangyi10
PROG:checker
LANG: PASCAL
}
var
num,sum,a,x,i,j,k,l,m,n:longint;
ans:array[..] of longint;
b,c,d:array[-..] of boolean;
{file}
procedure openf;
begin
assign(input,'checker.in'); reset(input);
assign(output,'checker.out'); rewrite(output);
end;
procedure closef;
begin
close(input); close(output);
halt;
end;
{queen}
procedure queen(row,ld,rd:longint);
var
pos,p:longint;
begin
if row<>x then
begin
pos:=x and not (row or ld or rd);
while pos<> do
begin
p:=pos and -pos;
pos:=pos-p;
queen(row+p,(ld+p)shl ,(rd+p)shr );
end;
end
else inc(sum);
end;
{print}
procedure print;
var
i:longint;
begin
for i:= to n- do
write(ans[i],' ');
writeln(ans[n]);
if num= then begin
writeln(sum);
closef;
end;
end;
{search}
procedure search(t:longint);
var
j:longint;
begin
if t> n then
begin
inc(num);
if num<= then print;
exit;
end;
for j:= to n do
if b[j] and c[t+j] and d[t-j] then
begin
ans[t]:=j;
b[j]:=false;
c[t+j]:=false;
d[t-j]:=false;
search(t+);
b[j]:=true;
c[j+t]:=true;
d[t-j]:=true;
end;
end;
begin
{input}
openf;
fillchar(c,sizeof(c),true);
fillchar(b,sizeof(b),true);
fillchar(d,sizeof(d),true);
readln(n);
x:=(( shl n)-);
{doit}
queen(,,);
search();
end.
USACO chapter1的更多相关文章
- USACO . Your Ride Is Here
Your Ride Is Here It is a well-known fact that behind every good comet is a UFO. These UFOs often co ...
- 【USACO 3.1】Stamps （完全背包）
题意:给你n种价值不同的邮票,最大的不超过10000元,一次最多贴k张,求1到多少都能被表示出来?n≤50,k≤200. 题解:dp[i]表示i元最少可以用几张邮票表示,那么对于价值a的邮票,可以推出 ...
- USACO翻译：USACO 2013 NOV Silver三题
USACO 2013 NOV SILVER 一.题目概览 中文题目名称 未有的奶牛 拥挤的奶牛 弹簧牛 英文题目名称 nocow crowded pogocow 可执行文件名 nocow crowde ...
- USACO翻译：USACO 2013 DEC Silver三题
USACO 2013 DEC SILVER 一.题目概览 中文题目名称 挤奶调度 农场航线 贝西洗牌 英文题目名称 msched vacation shuffle 可执行文件名 msched vaca ...
- USACO翻译：USACO 2014 DEC Silver三题
USACO 2014 DEC SILVER 一.题目概览 中文题目名称 回程 马拉松 奶牛慢跑 英文题目名称 piggyback marathon cowjog 可执行文件名 piggyback ma ...
- USACO翻译：USACO 2012 FEB Silver三题
USACO 2012 FEB SILVER 一.题目概览 中文题目名称 矩形草地 奶牛IDs 搬家 英文题目名称 planting cowids relocate 可执行文件名 planting co ...
- USACO翻译：USACO 2012 JAN三题（3）
USACO 2012JAN(题目三) 一.题目概览 中文题目名称 放牧 登山 奶牛排队 英文题目名称 grazing climb lineup 可执行文件名 grazing climb lineup ...
- USACO翻译：USACO 2012 JAN三题（2）
USACO 2012 JAN(题目二) 一.题目概览 中文题目名称 叠干草 分干草 奶牛联盟 英文题目名称 stacking baleshare cowrun 可执行文件名 stacking bale ...
- USACO翻译：USACO 2012 JAN三题（1）
USACO 2012 JAN(题目一) 一.题目概览 中文题目名称 礼物 配送路线 游戏组合技 英文题目名称 gifts delivery combos 可执行文件名 gifts delivery c ...
随机推荐
- 添加nginx为系统服务(service nginx start/stop/restart)
1.在/etc/init.d/目录下编写脚本,名为nginx #!/bin/sh # # nginx - this script starts and stops the nginx daemon # ...
- python 文件夹比较
参考:http://blog.csdn.net/imzoer/article/details/8675078 文件比较:filecmp模块:filecmp '''Created on 2014-6-6 ...
- codeforces 645E . Intellectual Inquiry
题目链接 如果不考虑重复的元素, 那么我们可以很容易的发现, 长度为n的字符串它的子串数量是 $ 2^n $ . 我们设每个到位置i, 答案的数量为f[i]. 然后我们考虑重复的, 我们发现, 每加入 ...
- [LeetCode]题解（python）：149-Max Points on a Line
题目来源: https://leetcode.com/problems/max-points-on-a-line/ 题意分析: 在一个2D的板上面有很多个点,判断最多有多少个点在同一条直线上. 题目思 ...
- [原创]使用GCC创建 Windows NT 下的内核DLL
原文链接:使用GCC创建 Windows NT 下的内核DLL 在温习<<Windows 2000 Driving>>分层驱动程序一章的时候,看到了关于紧耦合驱动连接方式,这种 ...
- Unicode字符列表
注:除非有特别指明,否则以下符号皆属“半角”而非“全角”. 代码 显示 描述 U+0020 空格 U+0021 ! 叹号 U+0022 " 双引号 U+0023 # 井号 U+0024 $ ...
- J2SE知识点摘记(十八)
Java容器类类库的用途是“保存对象”,并将其划分为两个不同的概念: 1) Collection . 一组对立的元素,通常这些元素都服从某种规则.List必须保持元素特定的顺序,而Set 不能有重复 ...
- 在Centos 5.x或6.x上安装RHEL EPEL Repo
本文介绍了如何在CentOS 5.x或者CentOS 6.x的系统上使用Fedora Epel repos一个第三方repo:remi资源库.这些资源包并不是天然地支持CentOS,但是提供了很多流行 ...
- OAuth认证的过程
在认证和授权的过程中涉及的三方包括: 服务提供方,用户使用服务提供方来存储受保护的资源,如照片,视频,联系人列表. 用户,存放在服务提供方的受保护的资源的拥有者. 客户端,要访 ...
- [Ext JS 4] Grid 实战之分页功能
前言 分页功能的实现有两种途径: 一种是服务端分页方式, 也就是web客户端传递页码参数给服务端,服务端根据页面参数返回指定条数的数据.也就是要多少取多少.这种方式比较适合Grid 的数据量很大,需 ...