Uses CRT;
var
 magazin:array[1..100] of set of char;
 tovar:array[1..100] of char;
 v1,v2,v3:set of char;
 temp:char;
 test,n,i,j,t,tov:integer;

begin
 clrscr;

 write('Vvedite kol-vo tovarov: ');
 readln(tov);
 writeln;

 for i:=1 to tov do
  begin
   write('Vvedite nazvanie ',i,' tovara (1 bukva): ');
   readln(tovar[i]);
  end;
 writeln;

 write('Vvedite kol-vo magazinov: ');
 readln(n);
 writeln;

 for i:=1 to n do
  begin
   write('Vvedite kol-vo tovarov v ',i,' magazine: ');
   readln(t);
   writeln;
   for j:=1 to t do
    begin
     write('Imja ',j,' tovara: ');
     readln(temp);
     magazin[i]:=magazin[i]+[temp];
    end;
   writeln;
  end;

 writeln;

 for i:=1 to tov do
  begin
   test:=0;
   for j:=1 to n do
    if tovar[i] in magazin[j] then inc(test);
   if test=0 then v1:=v1+[tovar[i]];
   if test>0 then v2:=v2+[tovar[i]];
   if test=n then v3:=v3+[tovar[i]];
   Writeln(Tovar[i],'  ',test);
  end;

 writeln('Resultat:');
 writeln('V kashdom magazine:');
 for i:=1 to tov do
  if tovar[i] in v3 then write(tovar[i],' ');

 writeln;

 writeln('Xotjabi v 1 magazine:');
 for i:=1 to tov do
  if tovar[i] in v2 then write(tovar[i],' ');

 writeln;

 writeln('Ni v odnim magazine:');
 for i:=1 to tov do
  if tovar[i] in v1 then write(tovar[i],' ');
 writeln;

 ReadKey
end.