noip2000-单词接龙2008.11.5

noip2000-单词接龙2008.11.5

小结：

1：要多想一想题中数据的特殊情况，多往外延想一想，看看与题目相关的到底都有哪些情况，这些情况又在不在题目的叙述的内涵中

2：想好，没有一点瑕疵了，再敲，否则要敲好多遍

 

program1：错误的算法

program words;
var f,la:array[1..20]of longint;
      a:array[1..20]of string;
      x:char;
      f1,f2:text;
      n,m,max,i:longint;
procedure qsort(i1,j1:longint);
var
l1,r1:longint;x1,y1:string;
begin
l1:=i1;r1:=j1;
x1:=a[(l1+r1) div 2];
repeat
while a[l1]<x1 do inc(l1);
while a[r1]>x1 do dec(r1);
 if l1<=r1 then
   begin
   y1:=a[l1];
   a[l1]:=a[r1];
   a[r1]:=y1;
   inc(l1);
   dec(r1);
   end;
until l1>r1;
if r1>i1 then qsort(i1,r1);
if l1<j1 then qsort(l1,j1);
end;
procedure init;
   var i:longint;
     begin
        assign(f1,'in.in');reset(f1);
        assign(f2,'out.out');rewrite(f2);
        readln(f1,n);
        for i:=1 to n do
           readln(f1,a[i]);
           read(f1,x);
        qsort(1,n);
        for i:=1 to n do
          begin
           la[i]:=length(a[i]);f[i]:=2;
           end;
      end;
procedure deal(p:string;m,lp:longint);
var i,j:longint;
begin
    i:=0;
    if m>max then max:=m;
    repeat inc(i);
    if (copy(p,lp,1)=copy(a[i],1,1))and(f[i]>0)and(pos(p,a[i])=0)and(pos(a[i],p)=0)
                then{错在这里，这样，再检索是否匹配时，就完全错了，只对比首尾的两个字母，
而非beast+ astonish=beastonish的形式了}
                   begin dec(f[i]);
                             j:=1; while (copy(p,lp+1-j,j)=copy(a[i],1,j)) do inc(j);
                             dec(j);
                             m:=m+la[i]-j;deal(a[i],m,la[i]);
                             m:=m-la[i]+j;inc(f[i]);
                    end;
    until (copy(a[i],1,1)>copy(p,lp,1));
end;
procedure doit;
var i:longint;
begin  max:=0;
    for i:=1 to n do
       if copy(a[i],1,1)=x then
          begin dec(f[i]);
                   deal(a[i],la[i],la[i]);
                   inc(f[i]);
          end;
      writeln(max);
end;
begin init; doit;close(f1);close(f2);end.

program 2:考虑不全面

program words;
var f,la:array[1..20]of longint;
      a:array[1..20]of string;
      x:char;
      f1,f2:text;
      n,m,max,i:longint;
procedure qsort(i1,j1:longint);
var
l1,r1:longint;x1,y1:string;
begin
l1:=i1;r1:=j1;
x1:=a[(l1+r1) div 2];
repeat
while a[l1]<x1 do inc(l1);
while a[r1]>x1 do dec(r1);
 if l1<=r1 then
   begin
   y1:=a[l1];
   a[l1]:=a[r1];
   a[r1]:=y1;
   inc(l1);
   dec(r1);
   end;
until l1>r1;
if r1>i1 then qsort(i1,r1);
if l1<j1 then qsort(l1,j1);
end;
procedure init;
   var i:longint;
     begin
        readln(n);
        for i:=1 to n do
           readln(a[i]);
           read(x);
        qsort(1,n);
        for i:=1 to n do
          begin
           la[i]:=length(a[i]);f[i]:=2;
           end;
      end;
function min(x1,x2:longint):longint;
begin if x1<x2 then exit(x1) else exit(x2);end;
procedure deal(p:string;m,lp:longint);
var i,j,lj:longint;
begin
    if m>max then max:=m;
   for i:=1 to n do
if (f[i]>0)and(pos(p,a[i])=0)and(pos(a[i],p)=0){错在这里
有一组数据是：input
1
envolope
e
output:15 ,而我的结果是8，错就错在了pos的用法，这样，若两个单词是完全相同的，也就是一个单词，则，按照我的错误的，自己和自己就不能叠加了，实际上是可以的。}
                then
                   begin     lj:=min(lp,la[i])-1;
                             j:=0;
                             repeat inc(j);
                             until (copy(p,lp+1-j,j)=copy(a[i],1,j)) or(j=lj);
                             if (copy(p,lp+1-j,j)=copy(a[i],1,j)) then
                                begin
                                   dec(f[i]);m:=m+la[i]-j;deal(a[i],m,la[i]);
                                   inc(f[i]);m:=m-la[i]+j;
                                end;
                    end;

end;
procedure doit;
var i:longint;
begin  max:=0;
    for i:=1 to n do
       if copy(a[i],1,1)=x then
          begin dec(f[i]);
                   deal(a[i],la[i],la[i]);
                   inc(f[i]);
          end;
      writeln(max);
end;
begin init; doit;end.

program 3:改进对自己接自己的

program words;
var f,la:array[1..20]of longint;
     a:array[1..20]of string;
     x:char;
     f1,f2:text;
     n,m,max,i:longint;
procedure qsort(i1,j1:longint);
var
l1,r1:longint;x1,y1:string;
begin
l1:=i1;r1:=j1;
x1:=a[(l1+r1) div 2];
repeat
while a[l1]<x1 do inc(l1);
while a[r1]>x1 do dec(r1);
 ifl1<=r1 then
  begin
  y1:=a[l1];
  a[l1]:=a[r1];
  a[r1]:=y1;
  inc(l1);
  dec(r1);
  end;
until l1>r1;
if r1>i1 then qsort(i1,r1);
if l1<j1 then qsort(l1,j1);
end;
procedure init;
  var i:longint;
    begin
       readln(n);
       for i:=1 to n do
          readln(a[i]);
          read(x);
       qsort(1,n);
       for i:=1 to n do
         begin
          la[i]:=length(a[i]);f[i]:=2;
          end;
     end;
function min(x1,x2:longint):longint;
begin if x1<x2 then exit(x1) elseexit(x2);end;
functionfind(m1,m2:string;):boolean;
begin
   if m1=m2 then exit(true);
   if(pos(m1,m2)<>0)or(pos(m2,m1)<>0) then exit(false) else exit(true);
end;
procedure deal(p:string;m,lp:longint);
var i,j,lj:longint;
begin
   if m>max then max:=m;
  for i:=1 to n do
   if (f[i]>0)and(find(p,a[i])){用一个函数来处理这个问题}
               then
                   begin     lj:=min(lp,la[i])-1;
                             j:=0;
                             repeat inc(j);
                             until(copy(p,lp+1-j,j)=copy(a[i],1,j)) or(j=lj);
                             if(copy(p,lp+1-j,j)=copy(a[i],1,j)) then
                                begin
                                  dec(f[i]);m:=m+la[i]-j;deal(a[i],m,la[i]);
                                  inc(f[i]);m:=m-la[i]+j;
                               end;
                    end;
 
end;
procedure doit;
var i:longint;
begin max:=0;
   for i:=1 to n do
      if copy(a[i],1,1)=x then
         begin dec(f[i]);
                   deal(a[i],la[i],la[i]);
                   inc(f[i]);
         end;
     writeln(max);
end;
begin init; doit;end.