记录编号 2827 评测结果 AAAAAAAA
题目名称 [NOIP 2002]字串变换 最终得分 100
用户昵称 Gravatarsywgz 是否通过 通过
代码语言 Pascal 运行时间 0.097 s
提交时间 2008-09-28 11:35:02 内存使用 0.51 MiB
显示代码纯文本
program ex;
uses crt;
const
 max=100;
type
  point=^node;
  node=record
   h:integer;
   s:string;
   fth,next:point;
  end;
var
 temp:string;
 f:text;
 fin:string;
 s1,s2:string;
 ch:char;
 a,b:array [1..max] of string;
 c:array[1..max] of integer;
 i,j,k,l:integer;
 open,head,tail:point;
procedure ini;
 begin
  assign(f,'string.in');
  reset(f);
  assign(output,'string.out');rewrite(output);
  readln(f,temp);
  k:=pos(' ',temp);
  s1:=copy(temp,1,k-1);
{  writeln('s1=',s1);}
  s2:=copy(temp,k+1,length(temp)-k);
{  writeln('s2=',s2);  }
  l:=0;
  while not eof(f) do
   begin
     inc(l);
     readln(f,temp);
     k:=pos(' ',temp);
     a[l]:=copy(temp,1,k-1);
{     writeln(a[l]);}
     b[l]:=copy(temp,k+1,length(temp)-k);
{     writeln(b[l]);}
   end;
  close(f);
  new(open);
  with open^ do
   begin
    h:=0;
    s:=s1;
    fth:=nil;
    next:=nil;
   end;
  head:=open;
  tail:=open^.next;
 end;
{procedure print(key:point);
 begin
  if key^.fth=nil
   then write(key^.s)
   else begin
    print(key^.fth);
    write('-->',key^.s);
   end;
 end;
}
function qf(dat:point):integer;
 var
   x:integer;
   temp:string;
   i,j:integer;
 begin
   temp:=dat^.s;
   if length(s2)>=length(temp)
     then  x:=length(s2)
     else  x:=length(temp);
   i:=1;
   while  (i<=length(s2)) and (i<=length(temp)) do
    begin
      if temp[i]=s2[i] then x:=x-1;
      inc(i);
    end;
   qf:=x;
 end;
function pc(nw,su:point):boolean;
 var
  nt:point;
 begin
  nt:=head;
  while (nt<>su)and(nt^.s<>nw^.s) do nt:=nt^.next;
  if nt=su then pc:=true else pc:=false;
 end;
{procedure csprint(p:point);
 var nt:point;
 begin
  nt:=p;
  while nt<>nil do
   begin
    write(nt^.s);
    write(' ',nt^.h);
    writeln(' ',qf(nt));
    nt:=nt^.next;
   end;
 end;
}
procedure kz(nw:point);
 var
   p:point;
   flag:0..1;
   tp:point;
   net:point;
   tm,t:string;
 begin
  repeat
   if nw^.h>=10 then
     begin
      write('NO ANSWER!'); close(output);
      halt;
     end;
   for i:=1 to l do c[i]:=0;
   for i:=1 to l do
    begin
     tm:=nw^.s;
     while (length(tm)<>0)and(pos(a[i],tm)<>0)  do
       begin
         c[i]:=c[i]+pos(a[i],tm);
         delete(tm,1,pos(a[i],tm));
         new(p);
         p^.h:=nw^.h+1;
         t:=nw^.s;
         insert(b[i],t,c[i]);
         delete(t,c[i]+length(b[i]),length(a[i]));
         p^.s:=t;
         {write(p^.s);
         readln; }
         p^.fth:=nw;
         if p^.s=s2 then
          begin
           writeln(p^.h);close(output);
          { print(p);}
{           readln;}
           halt;
          end;
          net:=nw;
         repeat
          tp:=net;
          net:=net^.next;
         until (net=nil) or (qf(p)<qf(net));
         p^.next:=net;
         tp^.next:=p;
       end;
    end;
{   csprint(nw);
   readln;}
   nw:=nw^.next;
  { dispose(nw);}
   until nw=nil;
 end;
begin
 clrscr;
 ini;
 kz(open);
end.