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:=1; d2:=1; {doit} readln(s); for i:=1 to length(s) do d1:=d1*(ord(s[i])-ord('A')+1) mod 47; readln(s); for i:=1 to length(s) do d2:=d2*(ord(s[i])-ord('A')+1) mod 47; {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[0..1005] of ansistring; amount,ans:array[0..1005] 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:=1 to n do readln(s[i]); {doit} for i:=1 to n do begin readln(s[0]); readln(now,k); if k<>0 then ave:=now div k; for j:=1 to n do if s[j]=s[0] then break; amount[j]:=now; if k=0 then inc(ans[j],now) else inc(ans[j],now mod k); for j:=1 to k do begin readln(s[0]); for l:=1 to n do if s[l]=s[0] then break; inc(ans[l],ave); end; end; {output} for i:=1 to n do writeln(s[i],' ',ans[i]-amount[i]); closef; end.
{ ID: jiangyi10 PROG: gift1 LANG: PASCAL } const modnum=99997; type link=^node; node=record t:longint; next:link; end; var top,ave,i,j,k,l,m,n,t,mo:Longint; a:array[0..1005] of ansistring; exl:array[0..modnum-1] of link; st,en:array[0..1005] 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:=0; for i:=1 to length(s) do ans:=((ans<<5)+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(0); while (a[w^.t]<>s)and(w^.next<>nil) do w:=w^.next; if a[w^.t]=s then exit(w^.t) else exit(0); end; {add} function add(s:string):longint; var w:link; t,hash,i,j:longint; begin hash:=bkdrhash(s); t:=find(s); if t<>0 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:=1 to n do begin readln(s); t:=add(s); end; {doit} for i:=1 to n do begin readln(s); k:=find(s); readln(st[k],mo); if mo=0 then inc(en[k],st[k]) else begin ave:=st[k] div mo; inc(en[k],st[k] mod mo); for j:=1 to mo do begin readln(s); l:=find(s); inc(en[l],ave); end; end; end; {output} for i:=1 to n do writeln(a[i],' ',en[i]-st[i]); closef; end.
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[0..7] 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 4)+(century div 4)-2*century+(26*(month+1)div 10)+12)+49) mod 7; end; begin {input} openf; readln(n); {doit} for i:=0 to n-1 do begin century:=19; year:=i; while year>=100 do begin dec(year,100); inc(century); end; for month:=3 to 12 do inc(ans[w(year,month,century)]); dec(year); if year<0 then begin inc(year,100); dec(century); end; for month:=13 to 14 do inc(ans[w(year,month,century)]); end; {output} write(ans[6],' ',ans[0]); for i:=1 to 5 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[0..10000] 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=0 then nowcolor:=s[x]; if (nowcolor<>s[x])and(s[x]<>'w')then exit else inc(behindlength); if x+1<=n then searchbehind(x+1) else searchbehind(1); end; procedure searchbefore(x:longint); begin if beforelength>n then exit; if beforelength=0 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-1>0 then searchbefore(x-1) else searchbefore(n); end; begin openf; readln(n); max:=0; for i:=1 to n do read(s[i]); for i:=1 to n do begin behindlength:=0; searchbehind(i); beforelength:=0; if i-1>0 then searchbefore(i-1) 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.
{ID: jiangyi10 PROG: beads LANG: PASCAL } var nowcolor,behindlength,beforelength,tmp,max,i,j,k,l,m,n,top,flag:longint; a:array[0..355] of char; block,color:array[0..355] 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=0 then nowcolor:=color[x]; if (nowcolor<>color[x])and(color[x]<>0)then exit else inc(behindlength,block[x]); if x+1<=top then searchbehind(x+1) else searchbehind(1); end; procedure searchbefore(x:longint); begin if beforelength>n then exit; if beforelength=0 then nowcolor:=color[x]; if nowcolor=0 then nowcolor:=color[x]; if(nowcolor<>color[x])and(color[x]<>0) then exit else inc(beforelength,block[x]); if x-1>0 then searchbefore(x-1) else searchbefore(top); end; begin {input} openf; readln(n); flag:=0; read(a[1]); for i:=2 to n do begin read(a[i]); if a[i]<>a[i-1] then begin inc(top); block[top]:=i-1-flag; flag:=i-1; if a[i-1]='b' then color[top]:=1; if a[i-1]='r' then color[top]:=2; end; end; inc(top); block[top]:=n-flag; if a[n]='b' then color[top]:=1; if a[n]='r' then color[top]:=2; {special} if top=1 then begin writeln(n); closef; end; {doit} if color[top]=color[1] then begin inc(block[1],block[top]); dec(top); end; for i:=1 to top do begin behindlength:=0; searchbehind(i); beforelength:=0; if i-1>0 then searchbefore(i-1) else searchbefore(top); if behindlength+beforelength>max then max:=behindlength+beforelength; end; {output} if max>n then writeln(n) else writeln(max); closef; end.
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[0..10005] 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+1)]; 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:=1 to n do readln(st[i],en[i]); {doit} randomize; qsort(1,n); k1:=st[1]; k2:=en[1]; ans1:=k2-k1; for i:=2 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[1..7] of boolean; a,b,d:array[1..10,1..10] 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:=1 to n do begin for j:=1 to n do read(a[i,j]); readln; end; for i:=1 to n do begin for j:=1 to n do read(b[i,j]); readln; end; {doit} for i:=1 to n do for j:=1 to n do begin if a[i,j]<>b[i,j] then c[6]:=false; if a[i,j]<>b[j,n-i+1] then c[1]:=false; if a[i,j]<>b[n-i+1,n-j+1] then c[2]:=false; if a[i,j]<>b[n-j+1,i] then c[3]:=false; if a[i,j]<>b[i,n-j+1] then c[4]:=false; end; if c[1] then writeln('1') else if c[2] then writeln('2') else if c[3] then writeln('3') else if c[4] then writeln('4') else if c[6] then writeln('6') else begin fillchar(c,sizeof(c),1); for i:=1 to n do for j:=1 to n do d[i,j]:=a[i,n-j+1]; for i:=1 to n do for j:=1 to n do begin if d[i,j]<>b[j,n-i+1] then c[1]:=false; if d[i,j]<>b[n-i+1,n-j+1] then c[2]:=false; if d[i,j]<>b[n-j+1,i] then c[3]:=false; end; if c[1] or c[2] or c[3] then writeln('5') else writeln('7'); 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[1..10000] of string; a:array[1..10000] 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:=1; y:=a; while b<>0 do begin if (b and 1)=1 then t:=t*y; y:=y*y; b:=b shr 1 ; end; exit(t); end; begin {input} bo:=false; assign(input,'dict.txt'); reset(input); for i:=1 to 4617 do begin readln(s[i]); for j:=1 to length(s[i]) do begin if (s[i][j]='A')or(s[i][j]='B')or(s[i][j]='C')then r:=2 else if (s[i][j]='D')or(s[i][j]='F')or(s[i][j]='E')then r:=3 else if (s[i][j]='G')or(s[i][j]='H')or(s[i][j]='I')then r:=4 else if (s[i][j]='J')or(s[i][j]='K')or(s[i][j]='L')then r:=5 else if (s[i][j]='M')or(s[i][j]='N')or(s[i][j]='O')then r:=6 else if (s[i][j]='P')or(s[i][j]='R')or(s[i][j]='S')then r:=7 else if (s[i][j]='T')or(s[i][j]='U')or(s[i][j]='V')then r:=8 else if (s[i][j]='W')or(s[i][j]='X')or(s[i][j]='Y')then r:=9; a[i]:=r*mi(10,length(s[i])-j)+a[i]; end; end; close(input); openf; readln(n); {output} for i:=1 to 4617 do if a[i]=n then begin bo:=true; k:=i; break; end; if not bo then writeln('NONE') else for i:=k to 4617 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[1..10000] 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:=1 to 300 do begin bo:=true; j:=i*i; k:=0; o:=0; while j<>0 do begin inc(k); a[k]:=s[j mod n+1]; j:=j div n; end; for j:=1 to k do if a[j]<>a[k-j+1] then bo:=false; if bo then begin m:=i; while m<>0 do begin inc(o); b[o]:=s[m mod n+1]; m:=m div n; end; for j:=o downto 1 do write(b[j]); write(' '); for j:=1 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[1..10000] 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<>0 do begin inc(m); o:=0; for i:=2 to 10 do begin k:=m; j:=0; while k<>0 do begin inc(j); a[j]:=s[k mod i+1]; k:=k div i; end; bo:=true; for l:=1 to j do if a[l]<>a[j-l+1] then bo:=false; if bo then inc(o); if o>= 2 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[0..10005] 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+1)]; 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:=1 to m do readln(v[i],w[i]); randomize; qsort(1,m); {doit} i:=0; 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:=0; end; until n=0; {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[0..205] 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+1)]; 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:=1 to n do readln(a[i]); {doit} randomize; qsort(1,n); sum:=a[n]-a[1]+1; for i:=1 to n-1 do a[i]:=a[i+1]-a[i]; qsort(1,n-1); for i:=n-1 downto n-k+1 do dec(sum,a[i]-1); {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[0..30005] 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:=1 to length(s) do begin l:=i; r:=i; bo:=true; temp:=-1; repeat if (l>=1)and(r<=n) then begin al:=0; ar:=0; while (al=0)and(l>0) do begin if s[l] in ['a'..'z'] then begin al:=ord(s[l])-ord('a')+1;inc(temp); end else if s[l] in['A'..'Z'] then begin al:=ord(s[l])-ord('A')+1;inc(temp);end else dec(l); end; while (ar=0)and(r<n) do begin if s[r] in ['a'..'z'] then begin ar:=ord(s[r])-ord('a')+1;inc(temp);end else if s[r] in ['A'..'Z'] then begin ar:=ord(s[r])-ord('A')+1;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<1) or (r>n) then bo:=false; until bo=false; l:=i; r:=i+1; bo:=true; temp := 0; repeat if (l>=1)and(r<=n) then begin al:=0; ar:=0; while (al=0)and(l>0) do begin if s[l] in ['a'..'z'] then begin al:=ord(s[l])-ord('a')+1;inc(temp);end else if s[l] in['A'..'Z'] then begin al:=ord(s[l])-ord('A')+1;inc(temp);end else dec(l); end; while (ar=0)and(r<n) do begin if s[r] in ['a'..'z'] then begin ar:=ord(s[r])-ord('a')+1;inc(temp);end else if s[r] in ['A'..'Z'] then begin ar:=ord(s[r])-ord('A')+1;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<1) 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 1..9; a:array[1..9] of longint; ans,a1,a2,a3,a4,x,a5,i,j,k,l,n:longint; s1,s5:array[1..4] of longint; s2:array[1..2] of longint; s3,s4:array[1..3] 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:=1 to n do begin read(a[i]); se:=se+[a[i]]; end; {doit} for a1:=1 to n do for a2:=1 to n do for a3:=1 to n do for a4:=1 to n do for a5:=1 to n do begin s1[1]:=a[a1]; s1[2]:=a[a2]; s1[3]:=a[a3]; s2[1]:=a[a4]; s2[2]:=a[a5]; if (s2[1]*s1[1]>=10)or(s2[2]*s1[1]>=10) then continue else if(s2[1]*s1[1]+(s2[1]*s1[2])div 10>=10)or(s2[2]*s1[1]+(s2[2]*s1[2])div 10>=10)then continue else begin bo:=true; x:=0; s3[3]:=s1[3]*s2[2]; x:=s3[3] div 10; s3[3]:=s3[3] mod 10; s3[2]:=s1[2]*s2[2]+x; x:=s3[2] div 10; s3[2]:=s3[2] mod 10; s3[1]:=s1[1]*s2[2]+x; x:=0; s4[3]:=s1[3]*s2[1]; x:=s4[3] div 10; s4[3]:=s4[3] mod 10; s4[2]:=s1[2]*s2[1]+x; x:=s4[2] div 10; s4[2]:=s4[2] mod 10; s4[1]:=s1[1]*s2[1]+x; x:=0; s5[4]:=s3[3]; s5[3]:=s3[2]+s4[3]; x:=s5[3] div 10; s5[3]:=s5[3] mod 10; s5[2]:=s3[1]+s4[2]+x; x:=s5[2] div 10; s5[2]:=s5[2] mod 10; s5[1]:=s4[1]+x; for i:=1 to 3 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[4] 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[1..9,0..5] of longint=((4,1,2,4,5,0), (3,1,2,3,0,0),(4,2,3,5,6,0),(3,1,4,7,0,0),(5,2,4,5,6,8), (3,3,6,9,0,0),(4,4,5,7,8,0),(3,7,8,9,0,0),(4,5,6,8,9,0)); var bo:boolean; i,j,k,l,m,n:longint; a,c,q:array[1..9] of longint; b:array[1..9] 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:=1 to 9 do begin read(k); if k=3 then a[i]:=1 else if k=6 then a[i]:=2 else if k=9 then a[i]:=3 else a[i]:=4; end; {doit} for q1:=0 to 3 do for q2:=0 to 3 do for q3:=0 to 3 do for q4:=0 to 3 do for q5:=0 to 3 do for q6:=0 to 3 do for q7:=0 to 3 do for q8:=0 to 3 do for q9:=0 to 3 do begin bo:=true; for i:=1 to 9 do c[i]:=a[i]; q[1]:=q1; q[2]:=q2; q[3]:=q3; q[4]:=q4; q[5]:=q5; q[6]:=q6; q[7]:=q7; q[8]:=q8; q[9]:=q9; for i:=1 to 9 do while q[i]>0 do begin for j:=1 to a1[i,0] do inc(c[a1[i,j]]); dec(q[i]); end; for i:=1 to 9 do if c[i] mod 4 <>0 then bo:=false; q[1]:=q1; q[2]:=q2; q[3]:=q3; q[4]:=q4; q[5]:=q5; q[6]:=q6; q[7]:=q7; q[8]:=q8; q[9]:=q9; if bo then begin if (q[1]<>0) and bo then begin write(1); dec(q[1]); end else if (q[2]<>0) and bo then begin write(2); dec(q[2]); end else if (q[3]<>0) and bo then begin write(3); dec(q[3]); end else if (q[4]<>0) and bo then begin write(4); dec(q[4]); end else if (q[5]<>0) and bo then begin write(5); dec(q[5]); end else if (q[6]<>0) and bo then begin write(6); dec(q[6]); end else if (q[7]<>0) and bo then begin write(7); dec(q[7]); end else if (q[8]<>0) and bo then begin write(8); dec(q[8]); end else if (q[9]<>0) and bo then begin write(9); dec(q[9]); end; for i:=1 to q[1] do write(' ',1); if q[2]<>0 then for i:=1 to q2 do write(' ',2); if q[3]<>0 then for i:=1 to q3 do write(' ',3); if q[4]<>0 then for i:=1 to q4 do write(' ',4); if q[5]<>0 then for i:=1 to q5 do write(' ',5); if q[6]<>0 then for i:=1 to q6 do write(' ',6); if q[7]<>0 then for i:=1 to q7 do write(' ',7); if q[8]<>0 then for i:=1 to q8 do write(' ',8); if q[9]<>0 then for i:=1 to q9 do write(' ',9); writeln; closef; end; end; end.
1.4.3 Arithmetic Progressions
直接暴力枚举每一种情况就可以了，不过需要排序剪枝一下，总的来说没什么技巧性。
{ID: jiangyi10 PROG:ariprog LANG: PASCAL } var b:array[0..625000]of boolean; a:array[0..500000]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+1)]; 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:=1 to n-1 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:=0 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(1,tot); l:=2*m*m; for i:=1 to 2*m*m div (n-1) do begin k:=(n-1)*i; for j:=1 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[0..20] of boolean; v:array[0..20,0..20,0..20] 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 =0 then ans[nc]:=true; if (na>0)and(na+nb>vb) then search(na-(vb-nb),vb,nc); if (na>0)and(na+nb<=vb) then search(0,na+nb,nc); if (nb>0)and(nb+na>va) then search(va,nb-(va-na),nc); if (nb>0)and(nb+na<=va) then search(na+nb,0,nc); if (nb>0)and(nb+nc>vc) then search(na,nb-(vc-nc),vc); if (nb>0)and(nb+nc<=vc) then search(na,0,nb+nc); if (nc>0)and(nc+nb>vb) then search(na,vb,nc-(vb-nb)); if (nc>0)and(nc+nb<=vb) then search(na,nb+nc,0); if (nc>0)and(nc+na>va) then search(va,nb,nc-(va-na)); if (nc>0)and(nc+na<=va) then search(nc+na,nb,0); if (na>0)and(na+nc>vc) then search(na-(vc-nc),nb,vc); if (na>0)and(na+nc<=vc) then search(na+nc,nb,0); end; begin {input} openf; readln(va,vb,vc); {doit} nc:=vc; search(na,nb,nc); ans[vc]:=true; for i:=0 to 20 do if ans[i] then break; n:=i; write(i); for i:=n+1 to 20 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[0..1005,0..1005] 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:=1 to n do for j:=1 to i do read(a[i,j]); {doit} for i:=n-1 downto 1 do for j:=1 to i do inc(a[i,j],max(a[i+1,j],a[i+1,j+1])); {output} writeln(a[1,1]); 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:=1; y:=a; while b<>0 do begin if b and 1=1 then t:=(t*y) mod m; y:=y*y mod m; b:=b shr 1; end; exit(t); end; {miller} function pan(t:int64):boolean; var i:longint; begin for i:=1 to 8 do begin w:=random(t-2)+1; if power(w,t-1,t)<>1 then exit(false); end; if power(2,t-1,t)<>1 then exit(false); if power(7,t-1,t)<>1 then exit(false); if power(61,t-1,t)<>1 then exit(false); exit(true); end; begin {input} openf; readln(m,n); randomize; {special} if (m<=5) and (n>=5) then writeln('5'); if (m<=7) and (n>=7) then writeln('7'); if (m<=11) and (n>=11) then writeln('11'); {3} for i:=1 to 9 do for j:=0 to 9 do if odd(i) then begin ans:=i*100+j*10+i; if (ans<m) or (ans>n)then continue; if pan(ans) then writeln(ans); end; {5} for i:=1 to 9 do for j:=0 to 9 do for k:=0 to 9 do if odd(i) then begin ans:=i*10000+j*1000+k*100+j*10+i; if (ans<m) or (ans>n) then continue; if pan(ans) then writeln(ans); end; {7} for i:=1 to 9 do for j:=0 to 9 do for k:=0 to 9 do for l:=0 to 9 do if odd(i) then begin ans:=i*1000000+j*100000+k*10000+l*1000+k*100+j*10+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[1..4] of longint=(1,3,7,9); 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:=1; y:=a; while b<>0 do begin if b and 1=1 then t:=(t*y) mod m; y:=y*y mod m; b:=b shr 1; end; exit(t); end; {miller} function pan(t:int64):boolean; var i:longint; begin if power(7,t-1,t)<>1 then exit(false); if power(61,t-1,t)<>1 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:=1 to 4 do begin ans:=m*10+a[i]; if pan(ans) then search(ans,x+1); end; end; begin {input} openf; readln(n); {special} if n=1 then begin writeln(2); writeln(3); writeln(5); writeln(7); end; {doit} if n>=2 then begin search(2,1); search(3,1); search(5,1); search(7,1); 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[1..100] of longint; b,c,d:array[-100..1000] 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<>0 do begin p:=pos and -pos; pos:=pos-p; queen(row+p,(ld+p)shl 1,(rd+p)shr 1); end; end else inc(sum); end; {print} procedure print; var i:longint; begin for i:=1 to n-1 do write(ans[i],' '); writeln(ans[n]); if num=3 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<= 3 then print; exit; end; for j:=1 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+1); 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:=((1 shl n)-1); {doit} queen(0,0,0); search(1); end.
愿你出走半生，归来仍是少年
