uses crt, listunik;
var perben:perlista;
    tarsak:array[1..20] of lista;
    db,i:byte;
    s1,s2:elemtip;
procedure beolv(db:byte);
var i,n:byte;
    s,a:elemtip;
begin
  listaures(tarsak[db]);
  write('V dlott neve: ');
  readln(s);
  write('H ny t rs t nevezte meg?: ');
  readln(n);
  for i:=1 to n do
  begin
    write(i,'. t rs: ');
    readln(a);
    listaba(tarsak[db],a);
  end;
  plistaba(perben,s);
  perben.akt^.tars:=tarsak[db].fej;
end;
procedure kiir;
var s:elemtip;
    i:byte;
    t:lista;
begin
  plistaelejere(perben);
  while perben.akt<>Nil do
  begin
    s:=plistaaktelem(perben);
    write(s,' -> ');
    t.fej:=perben.akt^.tars;
    t.akt:=t.fej;
    t.hiba:=false;
    while t.akt<>Nil do
    begin
      if t.akt^.kov<>nil then write(t.akt^.szoveg,', ')
                         else write(t.akt^.szoveg);
      if t.akt<>Nil then t.akt:=t.akt^.kov
                    else t.hiba:=true;
    end;
    writeln;
    plistakovre(perben);
  end;
end;
procedure kolcsonosen(s1,s2:elemtip);
var s:elemtip;
    i:byte;
    t:lista;
    elso,masodik:boolean;
begin
  elso:=false;
  masodik:=false;
  plistaelejere(perben);
  while perben.akt<>Nil do
  begin
    s:=plistaaktelem(perben);
    t.fej:=perben.akt^.tars;
    t.akt:=t.fej;
    t.hiba:=false;
    while t.akt<>Nil do
    begin
      if (s=s1) and (t.akt^.szoveg=s2) then elso:=true;
      if (s=s2) and (t.akt^.szoveg=s1) then masodik:=true;
      if t.akt<>Nil then t.akt:=t.akt^.kov
                    else t.hiba:=true;
    end;
    plistakovre(perben);
  end;
  if (elso) and (masodik) then writeln('Igen, ezek kolcsonosen mutogattak egymasra.')
                          else writeln('Nem, ezek nem neveztek meg egymast.');
end;
procedure maxkopott;
var maxos,s:elemtip;
    i:byte;
    t:lista;
    max:byte;
begin
  maxos:='';
  max:=0;
  plistaelejere(perben);
  while perben.akt<>Nil do
  begin
    s:=plistaaktelem(perben);
    t.fej:=perben.akt^.tars;
    t.akt:=t.fej;
    t.hiba:=false;
    db:=0;
    while t.akt<>Nil do
    begin
      db:=db+1;
      if t.akt<>Nil then t.akt:=t.akt^.kov
                    else t.hiba:=true;
    end;
    if db>max then
    begin
      max:=db;
      maxos:=s;
    end;
    plistakovre(perben);
  end;
  writeln(maxos,' nevezte meg a legt”bb bûnt rsat!');
end;
procedure upgrade;
var s:elemtip;
    p:perlista;
    i:byte;
    t:lista;
    db:byte;
    a:array[1..20] of elemtip;
begin
  db:=0;
  plistaelejere(perben);
  while perben.akt<>Nil do
  begin
    s:=plistaaktelem(perben);
    t.fej:=perben.akt^.tars;
    t.akt:=t.fej;
    t.hiba:=false;
    while t.akt<>Nil do
    begin
      p.fej:=perben.fej;
      p.akt:=p.fej;
      p.hiba:=false;
      while (p.akt<>Nil) and (p.akt^.szoveg<>t.akt^.szoveg) do
      begin
        if p.akt<>Nil then p.akt:=p.akt^.kov
                      else p.hiba:=true;
      end;
      if p.akt=Nil then
      begin
        i:=0;
        while (i<=db) and (a[i]<>t.akt^.szoveg) do
        begin
          i:=i+1;
        end;
        if i>db then
        begin
          db:=db+1;
          a[db]:=t.akt^.szoveg;
        end;
      end;
      if t.akt<>Nil then t.akt:=t.akt^.kov
                    else t.hiba:=true;
    end;
    plistakovre(perben);
  end;
  for i:=1 to db do
  begin
    plistaba(perben,a[i]);
    perben.akt^.tars:=nil;
{    writeln(a[i]);}
  end;
end;
begin
  clrscr;
  write('H ny v dlott van?: ');
  readln(db);
  plistaures(perben);
  for i:=1 to db do
  begin
    beolv(i);
  end;
  clrscr;
  writeln;
  writeln('---KIÖRATµS---');
  writeln;
  kiir;
  writeln;
  writeln('---Maxim lis megnevez‚s---');
  writeln;
  maxkopott;
  writeln;
  writeln('---K”lcs”n”s megnevez‚s---');
  writeln;
  write('Adjon meg egy nevet!: ');
  readln(s1);
  write('Adjon meg meg egyet, kerem!: ');
  readln(s2);
  kolcsonosen(s1,s2);
  writeln;
  writeln('---B‹v¡t‚s---');
  writeln;
  upgrade;
  kiir;
  readkey;
end.