program kroket;
uses crt; 

const zavodniku_max =100; 

type dat = record 
     stc : integer;
     jmeno: string;
     souperi : array [1..27]of integer;
     rozbeh : array [1..9] of integer;
     nahoda : real;
end;

var data : array [1..100] of dat;
    poradi: array [1..100] of integer;
    start: array [1..100] of integer;

    zavodniku,
    max_kol,
    nejvetsi_kolo,
    max_drah,
    max_shoda : integer;

procedure init_data;
{##################}
var I, J: integer;

begin
  for I:=1 to zavodniku_max do
    with data[I] do
      begin
        for J:=1 to 27 do
          souperi[J]:=0;
        for J:=1 to 9 do
          rozbeh[J]:=0;
        stc:=I;
        jmeno:='Jmeno';
        nahoda:=RANDOM(1);
     end;
end; {procedure init_data}

function losovani_kola(kolo:integer):integer;
{############################################}
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;
    {************************************************}
    var i,st: integer;
    begin
      st:=0;
      if kolo>1 then
        for i:=1 to 3+(kolo-2)*3 do
          if data[kdo].souperi[i]=skym then
            inc(st);
      kontrola_shody:=st;
    end; {function kontrola_shody}

    procedure zarad_soupere(odk,dok:integer);
    {***************************************}
    var i,j,k:integer;
    begin
      for i:=odk to dok do
        begin
          k:=1+(kolo-1)*3;
          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_kola}
  writeln('start losovani kola ',kolo);
  if kolo>nejvetsi_kolo then
    max_shoda:=1;
  losovani_kola:=1; {losovani probehlo uspesne}
  for I:=1 to zavodniku_max do
  begin
    start[I]:=0;
    poradi[i]:=0;
  end;
  prvni:=(1+(kolo-1)*4);
  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 4);
      kontrola_do:=i;
      repeat
        s:=nejblizsi_volny {nejblizsi v danem kole 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 {nelze najit vhodny na teto urovni}
        begin
          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+(kolo-1)*3 to kolo*3 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 4 = 0 then {ukoncena ctverice}
            zarad_soupere(i-3,i); {zarazeni souperu}
          inc(i); {dalsi pozice}
          pozice:=s;
          zarazka:=s;
        end;
    end;
    if i<2 then {nepodarilo se vytvorit kolo}
      begin
        writeln;
        writeln('nelze seradit kolo:',kolo:3);
        losovani_kola:=0;
      end
    else
      begin {kolo serazeno spravne}
        j:=1;
        for i:=1 to zavodniku do
          begin
            data[poradi[i]].rozbeh[kolo]:=j;
            inc(j);
          end;
      end;
end; {procedure_losovani kola}


var f:text;
    u,kl:integer;

begin {program kroket}
  assign(f,'vystu16.txt'); {nazev vystupniho souboru}
  rewrite(f);
  init_data;
  zavodniku:=16; {pocet zavodniku}
  nejvetsi_kolo:=9; {max. rozlosovatelne kolo}
  writeln('KROKET, zavodniku ',zavodniku);
  max_kol:=(zavodniku-1) div 3;
  if max_kol>9 then max_kol:=9;
  max_drah:=4;
  max_shoda:=0;
  writeln(f,'System KROKET pro ',zavodniku,' zavodniku, max. pocet kol ',max_kol);
  for kl:=1 to max_kol do
    if losovani_kola(kl)=1 then
      begin
        writeln(f,'rozlosovani kola ',kl:2);
        for u:=1 to zavodniku do
          write(f,poradi[u]:3);
        writeln(f);
      end
    else
      begin
        writeln(f,'nelze rozlosovat kolo ',kl:2);
        kl:=max_kol;
      end;
  writeln(f,'Informace o zavodnicich, souperich a rozbezich');
  for u:=1 to zavodniku do
    with data[u] do
      begin
        write(f,u:3,' -> ');
        for kl:=1 to max_kol*3 do
          write(f,souperi[kl]:3);
        write(f,' R:');
        for kl:=1 to max_kol do
          write(f,rozbeh[kl]:3);
        writeln(f);
      end;
  writeln(f);
  close(f);
end. {program kroket}