Cod sursa(job #125185)

Utilizator crisy_girlpop cristina crisy_girl Data 20 ianuarie 2008 11:56:51
Problema Restante Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasele 5-8 Marime 1.02 kb
var
	n,i,j,t,f,l,li,nr:longint;
  a:array[1..36000]of string;
  fol:array[1..36000]of boolean;
  alf:set of char;
  term:boolean;
begin
	readln(n);
  for i:= 1 to n do
		readln(a[i]);
  for i:= 1 to n-1 do
  	begin
  		if not fol[i] then
    		begin
        	li:=length(a[i]);
          for t:= 1 to li do
          	if not(a[i][t] in alf) then
            	alf:=alf+[a[i][t]];
  				for j:= i+1 to n do
        		if not fol[j] then
    					begin
      					l:=length(a[j]);
        				term:=false;f:=0;
    						if l=li then
        					begin
        						repeat
          						inc(f);
            					if not (a[j][f] in alf) then
            						term:=true;
          					until (term)or(f=l);	
      	  					if not term then
                    	begin
            						fol[j]:=true;
                        fol[i]:=true;
                      end;
	      					end;
          		end;
  			end;
      alf:=[];
  	end;
  for i:= 1 to n do
  	if not fol[i] then
    	inc(nr);
  writeln(nr);
end.