Cod sursa(job #1195335)

Utilizator maricasorinSorin-Gabriel maricasorin Data 6 iunie 2014 21:44:14
Problema Potrivirea sirurilor Scor 14
Compilator fpc Status done
Runda Arhiva educationala Marime 1.14 kb
program siruri;
type stringulet=array [1..2000000] of char;
type vector=array [1..1000] of integer;
var a,b:stringulet;
    v:vector;
    da,db,k,d:integer;
    f,g:text;
function posi(da,db:integer;a,b:stringulet):integer;
 var i,j:integer;
  ok:boolean;
 begin
 posi:=0;
 i:=1;
 ok:=false;
 while (i<=db-da+1) and (ok=false) do begin
   ok:=true;
   for j:=1 to da do if a[j]<>b[i+j-1] then ok:=false;
   if ok then posi:=i;
   i:=i+1;
   end;
 end;
procedure dele(p,nr:integer;var n:integer;var k:stringulet);
 var i,j:integer;
 begin
 for i:=1 to nr do begin
  n:=n-1;
  for j:=p to n do k[j]:=k[j+1];
  end;
 end;
begin
assign (f,'strmatch.in');
reset(f);
assign (g,'strmatch.out');
rewrite(g);
da:=0;
db:=0;
while not eoln(f) do begin
     da:=da+1;
     read(f,a[da]);
     end;
readln (f);
while not eoln(f) do begin
 db:=db+1;
 read(f,b[db]);
 end;
d:=0;
k:=0;
write (posi(da,db,a,b));
while posi(da,db,a,b)>0 do begin
     d:=d+1;
     v[d]:=posi(da,db,a,b)+k;
     k:=k+1;
     dele(posi(da,db,a,b),1,db,b);
     end;
writeln(g,d);
if d>1000 then for k:=1 to 1000 do write(g,v[k],' ')
 else for k:=1 to d do write (g,v[k],' ');
close(f);
close(g);
end.