Program history; Var N,id,i : integer; S: array[1..2000] of string(7); function compare(s1,s2: string):integer; var counter:integer; begin counter:=0; for i:=1 to 7 do if (s1[i]<> s2[i]) then inc(counter); compare:= counter; end; procedure doIt; var counter,i,j,min:integer; orig : string(7); begin min:=40000; for i:=1 to N do begin counter :=0; orig:=s[i]; for j:=1 to N do begin counter:=counter + compare(orig,s[j]); end; if (counter < min) then min := counter; end; writeln('The highest possible quality is 1/',min,'.'); end; Begin Repeat id:=1; Readln(N); if N<>0 then begin for i:=1 to N do begin readln(S[id]); Inc(id); end; doIt; end; Until N=0; End.