Cod sursa(job #101828)

Utilizator ProtomanAndrei Purice Protoman Data 13 noiembrie 2007 21:10:35
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 2 kb
var f1,f2:text;
    c:array[1..10000000] of char;
    s:array[1..50010] of string[21];
    i,j,n,m,nm,nr,dimh,h:longint;
    str:string[21];

procedure repair(i:longint);
var l,r,max:longint;
    aux:string[21];
begin
        l:=2*i;
        r:=l+1;
        max:=i;
        if (l<=dimh)and(s[l]>s[max]) then
                max:=l;
        if (r<=dimh)and(s[r]>s[max]) then
                max:=r;
        if max<>i then
        begin
                aux:=s[i];
                s[i]:=s[max];
                s[max]:=aux;
                repair(max);
        end;
end;

procedure buildheap;
var i:longint;
begin
        for i:=n div 2 downto 1 do
                repair(i);
end;

procedure heapsort;
var i:longint;
    aux:string[21];
begin
        buildheap;
        for i:=n downto 2 do
        begin
                aux:=s[1];
                s[1]:=s[i];
                s[i]:=aux;
                dec(dimh);
                repair(1);
        end;
end;

procedure search(li,ls:integer);
begin
        m:=(li+ls) div 2;
        if str=s[m] then
                inc(nr)
        else if li<ls then
                if str<s[m] then
                        search(li,m-1)
                else search(m+1,ls);
end;

begin
        assign(f1,'abc2.in');
        reset(f1);
        assign(f2,'abc2.out');
        rewrite(f2);
        while not eoln(f1) do
        begin
                inc(i);
                read(f1,c[i]);
        end;
        nm:=i;
        readln(f1);
        i:=0;
        while not eof(f1) do
        begin
                inc(i);
                readln(f1,s[i]);
        end;
        n:=i;
        h:=length(s[i]);
        dimh:=n;
        heapsort;
        str:='0';
        for i:=1 to h-1 do
                str:=str+c[i];
        for i:=h to nm do
        begin
                delete(str,1,1);
                str:=str+c[i];
                search(1,n);
        end;
        writeln(f2,nr);
        close(f1);
        close(f2);
end.