program pavouk; {verze 1.0}

uses crt;

const zavodniku_max =100;

type
  dat = record
    souperi : array [1..27] of integer;
  end;

var data : array [1..100] of dat;
    poradi: array [1..100] of integer;
    start: array [1..100] of integer;
    zavodniku,
    pocet_pavouku,
    max_pavouku,
    max_shoda : integer;

procedure init_data;
{vycisteni poli}
var I, J: integer;
begin
  for I:=1 to zavodniku_max do
    with data[I] do begin
      for J:=1 to 27 do
        data[I].souperi[J]:=0;
    end;
end; {procedure init_data}

function losovani_pavouku(pavouk:integer):integer;
{rozlosovani pavouku}
var prvni, pozice, zarazka, i, j : integer;
    konec : boolean;
    s, kontrola_od,kontrola_do,shoda : integer;

  function nejblizsi_volny:integer;
  var p: integer;
  begin
    p:=pozice;
    repeat
      inc(p);
      if p>zavodniku then p:=1;
      if p=zarazka then konec:=true;
    until (start[p]=0) or (p=pozice) or konec;
    nejblizsi_volny:=p;
  end; {function nejblizsi_volny}

  function kontrola_shody(kdo,skym:integer):integer;
  {zjisteni, zda spolu hraci jiz hrali}
  var i,st: integer;
  begin
    st:=0;
    if pavouk>1 then
      for i:=1 to 1+(pavouk-2) do
        if data[kdo].souperi[i]=skym then inc(st);
    kontrola_shody:=st;
  end; {function kontrola_shody}

  procedure zarad_soupere(odk,dok:integer);
  {zarazeni soupere do pavouku}
  var i,j,k:integer;
  begin
    for i:=odk to dok do begin
      k:=1+(pavouk-1);
      for j:=odk to dok do
        if i<>j then begin
          data[poradi[i]].souperi[k]:=poradi[j];
          inc(k);
        end;
    end;
  end; {procedure zarad_soupere}

begin {function losovani_pavouku}
  if pavouk>max_pavouku then max_shoda:=1;
  losovani_pavouku:=1; {losovani probehlo uspesne}
  for I:=1 to zavodniku_max do begin
    start[I]:=0;
    poradi[i]:=0;
  end;
  prvni:=(1+(pavouk-1)*2);
  while prvni>zavodniku do prvni:=prvni-zavodniku;
  pozice:=prvni;
  zarazka:=prvni;
  i:=1;
  poradi[i]:=prvni;
  start[pozice]:=1;
  inc(i);
  while (i<zavodniku+1) and (i>1) do begin
    konec:=false;
    kontrola_od:=i-((i-1) mod 2);
    kontrola_do:=i;
    repeat
      s:=nejblizsi_volny; {nejblizsi v dane discipline nezarazeny
                           hrac pocinaje za hodnotou pozice}
      shoda:=0;
      for j:=kontrola_od to kontrola_do-1 do
        shoda:=shoda+kontrola_shody(s,poradi[j]);
      {hrac S hral s hracem cislo pozice[j]? ano=1, ne=0}
      pozice:=s;
    until (shoda<=max_shoda) or konec;
    if konec then begin {nelze najit vhodny na teto urovni}
      dec(i);
      if i>0 then begin
        pozice:=poradi[i]; {vytazeni ukazovatka}
        if i=1 then zarazka:=prvni
        else zarazka:=poradi[i-1];
        poradi[i]:=0; {vyrazeni z poradi}
        for j:=1+(pavouk-1)*1 to pavouk*1 do {zruseni souperu}
          data[pozice].souperi[j]:=0;
        start[pozice]:=0; {zruseno zarazeni}
      end;
    end
    else begin
      poradi[i]:=s; {hrac do poradi}
      start[s]:=1; {hrac zarazen}
      if i mod 2 = 0 then {ukoncena dvojice}
        zarad_soupere(i-1,i); {zarazeni souperu}
      inc(i); {dalsi pozice}
      pozice:=s;
      zarazka:=s;
    end;
  end;
  if i<2 then begin {nepodarilo se vytvorit pavouka}
    writeln;
    writeln('nelze seradit pavouka:',pavouk:3);
    losovani_pavouku:=0;
  end
  else begin {pavouk serazen spravne}
    j:=1;
    for i:=1 to zavodniku do inc(j);
  end;
end; {procedure_losovani pavouku}

var f:text;
    u,kl:integer;

begin {program pavouk}
  zavodniku:=16;
  pocet_pavouku:=4;
  assign(f,'pavout.txt'); {nazev vystupniho souboru}
  rewrite(f);
  textmode(C80 + Font8x8);
  init_data;
  max_pavouku:=9; {max. pocet pavouku}
  if pocet_pavouku>max_pavouku then pocet_pavouku:=max_pavouku;
  max_shoda:=0;
  writeln(f,'PAVOUK pro ',zavodniku,' zavodniku, disciplin ',pocet_pavouku);
  writeln(f);
  writeln('PAVOUK pro ',zavodniku,' zavodniku, disciplin ',pocet_pavouku);
  writeln;
  for kl:=1 to pocet_pavouku do
    if losovani_pavouku(kl)=1 then begin
      writeln(f,'rozlosovani discipliny ',kl:2);
      writeln('rozlosovani discipliny ',kl:2);
      for u:=1 to zavodniku do begin
        write(f,poradi[u]:3);
        write(poradi[u]:3);
      end;
      writeln(f); writeln(f);
      writeln; writeln;
    end
  else begin
    writeln(f,'nelze rozlosovat disciplinu ',kl:2);
    writeln('nelze rozlosovat disciplinu ',kl:2);
    kl:=pocet_pavouku;
  end;
  writeln(f,'Informace o zavodnicich a jejich souperich');
  writeln('Informace o zavodnicich a jejich souperich');
  for u:=1 to zavodniku do
    with data[u] do begin
      write(f,u:3,' -> ');
      write(u:3,' -> ');
      for kl:=1 to pocet_pavouku do begin
        write(f,souperi[kl]:3);
        write(souperi[kl]:3);
      end;
      writeln(f);
      writeln;
    end;
  writeln(f);
  writeln;
  close(f);
end. {program PAVOUK}