POJ 1094(拓扑排序)

拓排+各种判……

Program P1094;
type
   map3=record
        indegree:array['A'..'Z'] of longint;
        map:array['A'..'Z',1..26] of char;
        outdegree:array['A'..'Z'] of longint;
        end;
var
   n,m,i,j,num,value,topvalue:longint;
   s:string;
   topout:string;
   map,map2:map3;
   mark:array['A'..'Z'] of boolean;
   tag:boolean;
Function topsort:longint;
var
   j,k,h,s,zero:longint;
   flag:boolean;
   i:char;
begin
   topsort:=3;
   topout:='';
   flag:=false;
   h:=1;
   s:=0;
   zero:=0;
   for i:='A' to 'Z' do if mark[i] then if map2.indegree[i]=0 then begin inc(zero); topout:=topout+i; end;
   if zero=0 then exit(2);
   s:=length(topout);
   while (h<=s) do
   begin
      if (h<s) then flag:=true;
      for j:=h to s do
      begin
         for k:=1 to map2.outdegree[topout[j]] do
         begin
            dec(map2.indegree[map2.map[topout[j],k]]);
            if map2.indegree[map2.map[topout[j],k]]=0 then
            begin
               topout:=topout+map2.map[topout[j],k];
            end;
         end;
         if length(topout)>num then exit(2);
      end;
      h:=s+1;
      s:=length(topout);
   end;
   if s<num then exit(2);
   if (s=num) and (num<n) then exit(3);

   if flag or (num<n) then exit(3) else exit(1);

end;
Procedure ski(step:longint);
var
   i:longint;
   s:string;
begin
   for i:=step+1 to m do readln(s);
end;
Procedure pri(value,step:longint);
begin
   if value=1 then writeln('Sorted sequence determined after ',step,' relations: ',topout,'.');
   if value=3 then writeln('Sorted sequence cannot be determined.');
   if value=2 then
   begin
      writeln('Inconsistency found after ',step,' relations.');
      ski(step);
   end;
   if value=1 then ski(step);
end;

begin
 {  assign(input,'P1094.in');
   assign(output,'p1094.out');
   reset(input);
   rewrite(output);    }
   readln(n,m);
   while (n+m>0) do
   begin
      topout:='';
      fillchar(map,sizeof(map),0);
      fillchar(mark,sizeof(mark),false);
      num:=0;
      value:=3;
      for i:=1 to m do
      begin
         readln(s);
         if (ord('A')-1+n<ord(s[1])) or (ord('A')-1+n<ord(s[3])) or (s[1]=s[3]) then
         begin
            value:=2;
            break;
         end;

         if not(mark[s[1]]) then begin mark[s[1]]:=true; inc(num); end;
         if not(mark[s[3]]) then begin mark[s[3]]:=true; inc(num); end;
         tag:=false;
         for j:=1 to map.outdegree[s[1]] do
            if map.map[s[1],j]=s[3] then begin tag:=true; break; end;
         if tag then continue;
         inc(map.indegree[s[3]]);
         inc(map.outdegree[s[1]]);
         map.map[s[1],map.outdegree[s[1]]]:=s[3];

         map2:=map;
         topvalue:=topsort;
         if topvalue<=2 then begin value:=topvalue; break; end;
      end;
      pri(value,i);
      readln(n,m);
   end;
{   close(input);
   close(output);  }
end.

字符串处理

Turbo Pascal提供了八个标准函数和标准过程,利用它们可以灵活解决字符串解题中的一些问题。 
length(st:string):byte 函数,返回st串的长度,既串中字符的个数。函数值字节型byte 0~255。
pos(sub,st:string):byte 函数,在st串中找子串sub,找到后返回值为sub在st中的位置,若没找到,函数值为0。                      
str(value,st) 函数,将整数或实数value转换成数字字符串st 。 
val(st, value,code) 过程,将字符串st 转换成数value, code返回st中第一个非法字符的位置,未有错,code为0。 
copy(st,pos,num) 函数, 在字符串st中从第pos个字符开始顺序截取num个字符。若pos大于st的长度,则返回空串。 
insert(sub,st,pos) 过程,在字符串st的第pos个字符位置处插入子串sub。 
delete(st,pos,num) 过程,删除st中第pos个字符开始的num个字符。 
upcase(st):st 函数,将字母ch转换成大写字母。

POJ 1008(模拟)

最后一天特判

Program P1008;
var
   n,i,j1,j2,j,day,month,year:longint;
   daytotal,tday,tmonth,tyear:longint;
   s,s1:string;
   mon:array[1..19] of string=('pop','no','zip','zotz','tzec','xul','yoxkin','mol','chen','yax','zac','ceh','mac','kankin','muan', 'pax', 'koyab', 'cumhu','uayet');
   tmon:array[1..20] of string=('imix', 'ik', 'akbal','kan','chicchan','cimi','manik','lamat','muluk','ok','chuen','eb','ben','ix','mem','cib','caban','eznab','canac','ahau');
begin
   readln(n);
   writeln(n);
   for i:=1 to n do
   begin
      readln(s);
      j1:=1;
      while (s[j1]<>'.') do inc(j1);
      s1:=copy(s,1,j1-1);
      val(s1,day);
      j2:=length(s);
      while (s[j2]<>' ') do dec(j2);
      s1:=copy(s,j2+1,5);
      val(s1,year);
      inc(j1);
      s1:=copy(s,j1+1,j2-j1-1);
      for j:=1 to 19 do
         if s1=mon[j] then
         begin
            month:=j;
            break;
         end;
      daytotal:=year*365+day+1+(month-1)*20;
      tyear:=(daytotal-1) div 260;
      tday:=(daytotal mod 13);
      if tday=0  then tday:=13;
      tmonth:=(daytotal mod 20);
      if tmonth=0 then tmonth:=20;
      writeln(tday,' ',tmon[tmonth],' ',tyear);
   end;

end.

POJ 1836(双向LIS)

双向LIS……居然数组又开小了……

Program P1836;
var
   n,i,j,ans:longint;
   a:array[1..1000] of double;
   ll,lr:array[1..1000] of longint;
function min(a,b:longint):longint;
begin
   if a<b then exit(a) else exit(b);
end;
begin
   fillchar(ll,sizeof(ll),0);
   fillchar(lr,sizeof(lr),0);

   read(n);
   for i:=1 to n do read(a[i]);
   ll[1]:=1;
   for i:=2 to n do
   begin
      for j:=1 to i-1 do
         if a[j]<a[i] then if (ll[j]>=ll[i]) then
            ll[i]:=ll[j]+1;
      if ll[i]=0 then inc(ll[i]);
   end;
   lr[n]:=1;
   for i:=n-1 downto 1 do
   begin
      for j:=i+1 to n do
         if a[j]<a[i] then if (lr[j]>=lr[i]) then
            lr[i]:=lr[j]+1;
      if lr[i]=0 then inc(lr[i]);
   end;
   ans:=n;
   for i:=1 to n do
      ans:=min(ans,n-(ll[i]+lr[i]-1));
   for i:=1 to n do
      for j:=i+1 to n do
         ans:=min(ans,n-(ll[i]+lr[j]));
   writeln(ans);
end.

POJ 1837(Dp水题)

这题居然不用高精度就能过……测试数据好弱

Program P1837;
var
   c,g,i,j,k,p:longint;
   li,w:array[1..20] of longint;
   f:array[1..20,-7500..7500] of longint;
begin
   fillchar(f,sizeof(f),0);
   read(c,g);
   for i:=1 to c do read(li[i]);
   for i:=1 to g do read(w[i]);
   for i:=1 to c do f[1,li[i]*w[1]]:=1;
   for i:=2 to g do
      for j:=1 to c do
      begin
         p:=li[j]*w[i];
         if p<0 then
         begin
            for k:=-7500 to 7500+p do
               if f[i-1,k-p]>0 then
                  inc(f[i,k],f[i-1,k-p])
         end
         else
         begin
            for k:=-7500+p to 7500 do
               if f[i-1,k-p]>0 then
                  inc(f[i,k],f[i-1,k-p]);
         end;
      end;
   writeln(f[g,0]);
end.