Cod sursa(job #125808)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 20 ianuarie 2008 18:38:02
Problema Restante Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.84 kb
program alex;
var f:text;
    s:array[1..1000]of string[16];
    j,i,n,d,y,nr:integer;
    h:char;
    e:boolean;
    c,a:array['a'..'z']of 0..16;
begin
assign(f,'restante.in');reset(f);
readln(f,n);
for i:=1 to n do
    begin
    readln(f,s[i]);
    for j:=1 to length(s[i]) do
        a[s[i][j]]:=a[s[i][j]]+1;
    if i>=2 then begin
    j:=0;
    e:=false;
    repeat
    j:=j+1;
    for y:=1 to length(s[j]) do
        c[s[j][y]]:=c[s[j][y]]+1;
    d:=0;
    for h:='a' to 'z' do
        if a[h]<>c[h] then d:=1;
    if d=0 then e:=true;
    for y:=1 to length(s[j]) do
        c[s[j][y]]:=0;
    until(e=true)or(j=i-1);
    if e=false then nr:=nr+1;
                           end;
    for j:=1 to length(s[i]) do
        a[s[i][j]]:=0;
    end;
close(f);
assign(f,'restante.out');rewrite(f);
writeln(f,nr);
close(f);
end.