rqnoj/302.pas

   1 const
   2   maxn=210;
   3
   4 var
   5   q,s:longint;
   6   patten:array [0..maxn] of string;
   7   text:string;
   8
   9 procedure init;
  10 var
  11   i,p:longint;
  12   tmp:string;
  13
  14 begin
  15   readln(p,q);
  16   for i:=1 to p do
  17     begin
  18       readln(tmp);
  19       text:=text+tmp;
  20     end;
  21   readln(s);
  22   for i:=1 to s do readln(patten[i]);
  23 end;
  24
  25 function max(p,q:longint):longint;
  26 begin
  27   if p>q then exit(p) else exit(q);
  28 end;
  29
  30 function match(st:string):boolean;
  31 var
  32   i:longint;
  33
  34 begin
  35   match:=false;
  36   for i:=1 to s do if pos(patten[i],st)=1 then exit(true);
  37 end;
  38
  39 procedure main;
  40 var
  41   i,j,k,len:longint;
  42   sum,opt:array [0..maxn,0..maxn] of longint;
  43
  44 begin
  45   fillchar(sum,sizeof(sum),0);
  46   fillchar(opt,sizeof(opt),0);
  47   len:=length(text);
  48   for i:=len downto 1 do
  49     for j:=i to len do
  50       if match(copy(text,i,j-i+1)) then sum[i,j]:=sum[i+1,j]+1 else sum[i,j]:=sum[i+1,j];
  51   opt[1]:=sum[1];
  52   for i:=2 to q do
  53     for j:=i+1 to len do
  54       for k:=i+1 to j-1 do
  55         opt[i,j]:=max(opt[i,j],opt[i-1,k]+sum[k+1,j]);
  56   writeln(opt[q,len]);
  57 end;
  58
  59 begin
  60   init;
  61   main;
  62 end.