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.