USACO Section 1.2 题解

这一节，都是模拟，不过这些题对提高编码水平很大提高，这些题都做会了代码能力也不会差，你就可以专心研究算法了

 

 

---------------------------------------------------------------------------美丽的分界线-------------------------------------------------------------------------

USACO 1.2.1 Milking Cows 挤牛奶

 

 

program  milk2(input,output);
var
  n,i,j,k,x,y,max1,max2,l1,l2:longint;
  a:array[1..1000000] of boolean;
procedure init;
begin
 assign(input,'milk2.in');
 assign(output,'milk2.out');
 reset(input);
 rewrite(output);
end;
procedure outit;
begin
 close(input);
 close(output);
end;
begin
  init;
  readln(n);
  l1:=maxlongint;
  for i:=1 to n do
    begin
      readln(x,y);
      for j:=x to y-1 do a[j]:=true;
      if x<l1 then l1:=x;
      if y-1>l2 then l2:=y-1;
    end;
  j:=0;k:=0;
  for i:=l1 to l2 do
      if a[i] then
        begin
          inc(j);
          k:=0;
          if max1<j then max1:=j;
        end
              else
        begin
          inc(k);
          j:=0;
          if max2<k then max2:=k;
        end;
  writeln(max1,' ',max2);
  outit;
end.

 

 

USACO 1.2.2 Transformations 方块转换

 

program transform(input,output);
 var
  i,j,n:longint;
  g:boolean;
  a,b,c:array[1..10] of string;
procedure init;
 begin
  assign(input,'transform.in');
  assign(output,'transform.out');
  reset(input);
  rewrite(output);
 end;
procedure outit;
 begin
  close(input);
  close(output);
 end;

procedure work;
 var
   i,j:longint;
   s:array[1..10] of string;
 begin
   for i:=1 to n do
   for j:=1 to n do
   s[i,j]:=c[n-j+1,i];
   c:=s;
 end;
function ok:boolean;
 var
   i,j:longint;
 begin
    for i:=1 to n do
    for j:=1 to n do
    if c[i,j]<>b[i,j] then exit(false);
    exit(true);
 end;
begin
  init;
  readln(n);
  for i:=1 to n do readln(a[i]);
  for i:=1 to n do readln(b[i]);
  c:=a;
  for i:=1 to 3 do
    begin
      work;
      if ok then begin writeln(i);outit;halt;end;
    end;
  for i:=1 to n do
    for j:=1 to n do
      c[i,j]:=a[i,n-j+1];
  if ok then begin writeln(4);outit;halt;end;
  for i:=1 to 3 do
    begin
      work;
      if ok then begin writeln(5);outit;halt;end;
    end;
  g:=true;
  for i:=1 to n do
    for j:=1 to n do
      if a[i,j]<>b[i,j] then begin g:=false;break;end;
  if g then begin writeln(6);outit;halt;end;
  writeln(7);
  outit;
end.

 

 

USACO 1.2.3 Name That Number 命名那个数字

 

program namenum(input,output);
var
  f:text;
  s,n:string;
  ch:char;
  g,ok:boolean;
  i,j:longint;
procedure init;
 begin
   assign(input,'namenum.in');
   assign(output,'namenum.out');
   reset(input);
   rewrite(output);
 end;
procedure outit;
 begin
   close(input);
   close(output);
 end;
begin
  init;
  assign(f,'dict.txt');
  reset(f);
  readln(n);
  while not eof(f) do
    begin
      readln(f,s);
      if length(s)=length(n)then
        begin
          g:=true;
          for i:=1 to length(s) do
            begin  
              case s[i] of
               'A'..'C':ch:='2';
  	       'D'..'F':ch:='3';
               'G'..'I':ch:='4';
               'J'..'L':ch:='5';
               'M'..'O':ch:='6';
               'P'..'S':ch:='7';
               'T'..'V':ch:='8';
               'W'..'Y':ch:='9';
              end;
              if ch<>n[i] then begin g:=false;break;end;
            end;
          if g then begin writeln(s);ok:=true;end;
        end;
     end;
  if not(ok) then writeln('NONE');
  close(f);
  outit;
end.

 

 

USACO 1.2.4 Palindromic Squares 回文平方数

 

program palsquare(input,ouput);
var
  n,i,j,i1,i2:longint;
  a:array[1..100] of longint;
procedure init;
 begin
   assign(input,'palsquare.in');
   assign(output,'palsquare.out');
   reset(input);
   rewrite(output);
 end;
procedure outit;
 begin
   close(input);
   close(output);
 end;
procedure work(h:longint);
 var
   k:longint;
 begin
   k:=h;
   while k<>0 do
     begin
       inc(i1);
       a[i1]:=k mod n;
       k:=k div n;
     end;
 end;
function ok:boolean;
 var
   i:longint;
 begin
   for i:=1 to i1 div 2 do
     if a[i]<>a[i1-i+1]then exit(false);
   exit(true);
 end;
begin
  init;
  readln(n);
  for i:=1 to 300 do
    begin
      i1:=0;fillchar(a,sizeof(a),0);
      work(sqr(i));
      if ok then
        begin
          i2:=i1;
          work(i);
          for j:=i1 downto i2+1 do
            if a[j]<10 then write(a[j])
                       else write(chr((a[j] mod 10)+ord('A')));
          write(' ');
          for j:=i2 downto 1 do
            if a[j]<10 then write(a[j])
                       else write(chr((a[j] mod 10)+ord('A')));
          writeln;
        end;
    end;
  outit;
end.

 

 

USACO 1.2.5 Dual Palindromes 双重回文数

 

program dualpal(input,output);
var
  n,n1,s,s1,i,j,i1:longint;
  a:array[1..100] of longint;
procedure init;
 begin
   assign(input,'dualpal.in');
   assign(output,'dualpal.out');
   reset(input);
   rewrite(output);
 end;
procedure outit;
 begin
   close(input);
   close(output);
 end;
procedure work(j,h:longint);
 var
   k:longint;
 begin
   k:=h;
   while k<>0 do
     begin
       inc(i1);
       a[i1]:=k mod j;
       k:=k div j;
     end;
 end;
function ok:boolean;
 var
   i:longint;
 begin
   for i:=1 to i1 div 2 do
     if a[i]<>a[i1-i+1] then exit(false);
   exit(true);
 end;
begin
  init;
  readln(n,s);
  s1:=s;
  while n1<n do
    begin
      inc(s1); i:=0;
      for j:=2 to 10 do
        begin
          i1:=0;fillchar(a,sizeof(a),0);
          work(j,s1);
          if ok then inc(i);
          if i>=2 then
            begin
              writeln(s1);
              inc(n1);
              break;
            end;
        end;
     end;
  outit;
end.