POJ 1459(预留推进)

hllp写到最后写成预留推进了……

Program P1459;
var
   n,np,nc,m,i,j,src,t,level:longint;
   ch:char;
   s:string;
   d,e,pre:array[-1..100] of longint;
   map,f:array[-1..100,-1..100] of longint;
   queue:array[1..102] of longint;
   list:array[0..103,0..102] of longint;
   b:array[-1..100] of boolean;
function min(a,b:longint):longint;
begin
   if a<b then exit(a) else exit(b);
end;
function max(a,b:longint):longint;
begin
   if a>b then exit(a) else exit(b);
end;

procedure hllp;
var
   i,j,maxflow,flow,minj:longint;
   h,t:longint;
   tag:boolean;
begin
   level:=0;
   maxflow:=0;
   flow:=0;
   h:=1;
   t:=1;
   queue[h]:=n;
   while h<=t do
   begin
      for i:=0 to n-1 do
         if (map[i,queue[h]]>0) and (not(b[i])) then
         begin
            inc(t);
            queue[t]:=i;
            d[i]:=d[queue[h]]+1;
            b[i]:=true;
         end;
      inc(h);
   end;
   d[-1]:=n+2;
   {
   for i:=0 to n-1 do
      if e[i]>0 then
      begin
         inc(list[d[i],0]);
         list[d[i],list[d[i],0]]:=i;
         level:=max(level,d[i]);
      end;
   }
   while (true) do
   begin
      i:=n;
      for j:=0 to n-1 do
      begin
         if (e[j]>0) and (d[j]>d[i]) then i:=j;
      end;
      if i=n then break;
 {     i:=list[level,list[level,0]];
      dec(list[level,0]);
      while (level>0) and (list[level,0]=0) do dec(level);
      }

      tag:=false;
      for j:=-1 to n do
      begin
         if e[i]=0 then break;
            if (d[i]=d[j]+1) and (map[i,j]-f[i,j]>0) then
            begin
               tag:=true;
               flow:=min(map[i,j]-f[i,j],e[i]);
               dec(e[i],flow);
               inc(e[j],flow);
               inc(f[i,j],flow);
               f[j,i]:=-f[i,j];
            end;
      end;
      if (e[i]>0) then
      begin
         minj:=maxlongint;
         for j:=-1 to n do
            if (map[i,j]-f[i,j]>0) {and (d[i]>=d[j])} then minj:=min(minj,d[j]);
        { if minj=maxlongint then
         begin
            e[i]:=0;
            continue;
         end;    }
         d[i]:=minj+1;
      end;

   end;

end;
function isdight(a:char):boolean;
begin
   if (48<=ord(a)) and (ord(a)<=57) then exit(true) else exit(false);
end;
procedure rea(var a:longint);
var
   ch:char;
   s:string;
begin
   ch:=' ';
   while not(isdight(ch)) do read(ch);
   s:='';
   repeat
      s:=s+ch;
      read(ch);
   until not(isdight(ch));
   val(s,a);
end;
begin
{   assign(input,'p1459.in');
   assign(output,'p1459.out');
   reset(input);
   rewrite(output);                    }
   while not seekeof do
   begin
      fillchar(map,sizeof(map),0);
      fillchar(e,sizeof(e),0);
      fillchar(f,sizeof(f),0);
      fillchar(list,sizeof(list),0);
      fillchar(d,sizeof(d),0);
      fillchar(b,sizeof(b),false);
      rea(n);
      for i:=-1 to n do pre[i]:=i;
      rea(np);
      rea(nc);
      rea(m);
      for i:=1 to m do
      begin
        rea(src);
        rea(t);
        rea(map[src,t]);
      end;
      for i:=1 to np do
      begin
        rea(t);
        rea(map[-1,t]);
        e[t]:=map[-1,t];
        f[-1,t]:=map[-1,t];
        f[t,-1]:=-map[-1,t];
      end;
      for i:=1 to nc do
      begin
         rea(src);
         rea(map[src,n]);
      end;

      hllp;
      writeln(e[n]);
   end;
{   close(input);
   close(output);     }
end.

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.

POJ 1007(求逆序对数)

求逆序对数,2关键字排序

Program P1007;
var
   n,m,i,j,k,l,p:longint;
   a:array[1..200] of string;
   s:string;
   b,num:array[1..200] of longint;
function h(s:string):longint;
var
   i,j,a,c,g,t:longint;
begin
   a:=0;
   c:=0;
   g:=0;
   t:=0;
   h:=0;
   for i:=length(s) downto 1 do
   begin
      if s[i]='A' then inc(a);
      if s[i]='C' then
      begin
         inc(c);
         inc(h,a);
      end;
      if s[i]='G' then
      begin
         inc(g);
         inc(h,a+c);
      end;
      if s[i]='T' then
      begin
         inc(t);
         inc(h,a+c+g);
      end;
   end;
end;
procedure qsort(l,r:longint);
var
   i,j,m,p:longint;
   s2:string;
begin
   i:=l;
   j:=r;
   m:=b[(l+r) div 2];
   repeat
      while b[i]<m do inc(i);
      while b[j]>m do dec(j);
      if i<=j then
      begin
         p:=b[i];
         b[i]:=b[j];
         b[j]:=p;
         p:=num[i];
         num[i]:=num[j];
         num[j]:=p;
{         s2:=a[i];
         a[i]:=a[j];
         a[j]:=s2;
}        inc(i);
         dec(j);
      end;
   until i>j;
   if l<j then qsort(l,j);
   if i<r then qsort(i,r);
end;
begin
   readln(n,m);
   for i:=1 to m do
   begin
      readln(a[i]);
      b[i]:=h(a[i]);
      num[i]:=i;
   end;
   qsort(1,m);
   i:=1;
   while (i<m) do
   begin
      if b[i]<b[i+1] then inc(i)
      else
      begin
         for j:=i+1 to m do if b[j]<>b[i] then break;
         if (b[i]<>b[m]) then dec(J);
         for k:=i to j-1 do
            for l:=k+1 to j do
               if num[k]>num[l] then
               begin
                  p:=num[k];
                  num[k]:=num[l];
                  num[l]:=p;
 {                 s:=a[k];
                  a[k]:=a[l];
                  a[l]:=s;
  }             end;
         i:=j+1;
      end;
   end;
   for i:=1 to m do writeln(a[num[i]]);
end.

POJ 1006(中国剩余定理)

中国剩余定理

若一个数除m1余p1,除m2余p2……,除mn余pn (m1,m2……,mn互质)

则求 k1使k1=m2*……*mn的倍数且除m1余1

……

则这个数为(k1*p1+k2*p2+……kn*pn) mod (m1*m2*……*mn)

Program P1005;
var
   a,b,c,d,i,a1,a2,a3,ans:longint;
begin
   i:=1;
   a1:=28*33;
   a2:=23*33;
   a3:=23*28;
   while (a1 mod 23<>1) do inc(a1,28*33);
   while (a2 mod 28<>1) do inc(a2,23*33);
   while (a3 mod 33<>1) do inc(a3,23*28);

   while (true) do
   begin
      read(a,b,c,d);
      if (a=-1) and (b=-1) and (c=-1) and (d=-1) then break;
      ans:=(a1*a+a2*b+a3*c+21252-d) mod 21252;
      if ans=0 then ans:=21252;
      writeln('Case ',i,': the next triple peak occurs in ',ans,' days.');
      inc(i);
   end;
end.

POJ 1005(向后去整)

小数处理……

Program P1005;
const
   pi=3.1415926;
Var
   t,i,j:longint;
   x,y,s:double;
begin
   read(t);
   for i:=1 to t do
   begin
      read(x,y);
      s:=sqrt(x*x+y*y);
      s:=s*s*pi/2;
      s:=s/50;
      if trunc(s)<s then s:=trunc(s)+1
      else s:=trunc(s);
      writeln('Property ',i,': This property will begin eroding in year ',s:0:0,'.');

   end;
   writeln('END OF OUTPUT.');
end.