Cod sursa(job #102772)

Utilizator borsosborsos adrian borsos Data 14 noiembrie 2007 18:11:07
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 1.83 kb
var a:array[1..10000000] of char;
    kkt:array[1..50000] of string[21];
    cuvant,cuvant2:string[21];
    i,nrpoz,j,yy,aux:longint;
    f,g:text;
    ok:boolean;
begin
assign(f,'abc2.in'); reset(f);
assign(g,'abc2.out'); rewrite(g);
i:=0; nrpoz:=0;
while not eoln(f) do begin
                  inc(i);
                  read(f,a[i]);
                     end;
readln(f); yy:=i;aux:=0;
while not eof(f) do begin
          inc(aux);
          readln(f,kkt[aux]);

          ok:=true;
          for i := 1 to aux-1 do if kkt[aux] = kkt[i] then begin
                                                       ok := false;
                                                       break;
                                                           end;

          cuvant:=kkt[aux];

      if not ok then aux:=aux-1 else

      if ok then begin
          i:=1;
       while i < (yy-length(cuvant)+1) do begin
          while a[i] <> cuvant[1] do inc(i);

          cuvant2:='';

          if a[i+1] = cuvant[2] then begin
                  ok:=true;
                  for j := 3 to length(cuvant) do
                           if cuvant[j]<>a[j+i-1] then begin ok := false;
                                                           break;
                                                     end;

                  if ok then begin
                                           inc(nrpoz);
                                           i:=i+ length(cuvant)-1;
                                           end else
                                           inc(i);
                                     end
                                     else
                                     inc(i);

                                          end;
                    end;
                 end;
writeln(g,nrpoz);
close(f);
close(g);
end.