program mutace;
uses crt;
var pideal:array[1..37] of char;
    ppotomek:array[1..7,1..37] of char;
    pshoda:array[1..7] of byte;
    psrovnane:array[1..7] of byte;
    pozice:byte;
    cislopotomek:byte;
    hodnota:char;
    hodn:char;
    tmp:byte;
    i:byte;
    odloz:byte;

    prvni,druhy,predposledni,posledni:byte;
    cyklus:integer;
    volba:char;

    vstup:byte;
    kroku,krokucelkem:longint;
    mutuj:integer;

procedure logoprogramu;
          begin
          TextBackground(0);
          TextColor(15);
          clrscr;
          TextColor(3);
          write('--------------------------------------------------------------------------------');
          TextColor(15);
          writeln(' Mutace a Mutacky -->> ZK <<-- zk.zk@post.cz ---- SPSSE a VOS Liberec 21.4.2000');
          TextColor(3);
          writeln('--------------------------------------------------------------------------------');
          TextColor(7);
          writeln('');
          end;

function rnd(vstup:byte):char;
         begin
         tmp:=random(vstup);
         tmp:=tmp+48;
         hodnota:=chr(tmp);
         rnd:=hodnota;
         end;

procedure vybermutuj;
          begin
          repeat
          clrscr;
          logoprogramu;
          writeln;
          writeln(' Vlozte mutacni naracnost "0" az "5" ');
          write('   - Mutacnost: ');
          hodnota:=readkey;
          until (hodnota='0') or (hodnota='1') or (hodnota='2') or (hodnota='3') or (hodnota='4') or (hodnota='5');
          if hodnota='0' then mutuj:=0;
          if hodnota='1' then mutuj:=1;
          if hodnota='2' then mutuj:=2;
          if hodnota='3' then mutuj:=3;
          if hodnota='4' then mutuj:=4;
          if hodnota='5' then mutuj:=5;

          end;


procedure vyberslozitost;
          begin
          repeat
          clrscr;
          logoprogramu;
          writeln;
          writeln(' Vlozte kombinacni slozitost "2" az "9" ');
          write('   - Slozitost: ');
          hodnota:=readkey;
until (hodnota='2')or(hodnota='3')or(hodnota='4')or(hodnota='5')or(hodnota='6')or(hodnota='7')or(hodnota='8')or(hodnota='9');
          if hodnota='2' then vstup:=2;
          if hodnota='3' then vstup:=3;
          if hodnota='4' then vstup:=4;
          if hodnota='5' then vstup:=5;
          if hodnota='6' then vstup:=6;
          if hodnota='7' then vstup:=7;
          if hodnota='8' then vstup:=8;
          if hodnota='9' then vstup:=9;
          end;

procedure poleukaz;
          begin
          clrscr;
          logoprogramu;
          writeln;
          writeln('    -------------------------------------------------------------------');
          textcolor(5);
          write('     Idealni jedinec: ');
          textcolor(3);
          pozice:=0;
          repeat
            pozice:=pozice+1;
            write(pideal[pozice]);
          until pozice=36;
          textcolor(7);
          write(' - shoda: ');
          textcolor(9);
          writeln('36');
          textcolor(7);
          writeln;
          cislopotomek:=0;
          repeat
            cislopotomek:=cislopotomek+1;
            textcolor(6);
            write('          ',cislopotomek,'. jedinec: ' );
            pozice:=0;
            repeat
              pozice:=pozice+1;
              if ppotomek[cislopotomek,pozice]=pideal[pozice] then
                 begin
                 textcolor(2);
                 write(ppotomek[cislopotomek,pozice]);
                 end
               else
                 begin
                 textcolor(8);
                 write(ppotomek[cislopotomek,pozice]);
                 end;
            until pozice=36;
            textcolor(7);
            write(' - shoda: ');
            textcolor(9);
            writeln(pshoda[cislopotomek]);
          until cislopotomek=6;
          textcolor(7);
          writeln('    -------------------------------------------------------------------');
          end;

procedure poleideal;
       begin
       if vstup=2 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" a "1" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodnota:=readkey;
            until (hodnota='0') or (hodnota='1');
            pideal[pozice]:=hodnota;
          until pozice=36;
       end;

       if vstup=3 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" az "2" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodnota:=readkey;
            until (hodnota='0')or(hodnota='1')or(hodnota='2');
            pideal[pozice]:=hodnota;
          until pozice=36;
       end;

       if vstup=4 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" az "3" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodnota:=readkey;
            until (hodnota='0')or(hodnota='1')or(hodnota='2')or(hodnota='3');
            pideal[pozice]:=hodnota;
          until pozice=36;
       end;

       if vstup=5 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" az "4" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodnota:=readkey;
            until (hodnota='0')or(hodnota='1')or(hodnota='2')or(hodnota='3')or(hodnota='4');
            pideal[pozice]:=hodnota;
          until pozice=36;
       end;

       if vstup=6 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" az "5" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodnota:=readkey;
until (hodnota='0')or(hodnota='1')or(hodnota='2')or(hodnota='3')or(hodnota='4')or(hodnota='5');
            pideal[pozice]:=hodnota;
          until pozice=36;
       end;

       if vstup=7 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" az "6" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodnota:=readkey;
until (hodnota='0')or(hodnota='1')or(hodnota='2')or(hodnota='3')or(hodnota='4')or(hodnota='5')or(hodnota='6');
            pideal[pozice]:=hodnota;
          until pozice=36;
       end;

       if vstup=8 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" az "7" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodnota:=readkey;
until (hodnota='0')or(hodnota='1')or(hodnota='2')or(hodnota='3')or(hodnota='4')or(hodnota='5')or(hodnota='6')or(hodnota='7');
            pideal[pozice]:=hodnota;
          until pozice=36;
       end;

       if vstup=9 then
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            repeat
              clrscr;
              logoprogramu;
              writeln;
              writeln(' Vlozte kombinaci "0" az "8" ','(zbyva: ',37-pozice,' zanku)');
              write('   - Kombinace: ');
              tmp:=0;
              for tmp:=1 to (pozice-1) do
                begin
                write(pideal[tmp]);
                end;
              hodn:=readkey;
until (hodn='0')or(hodn='1')or(hodn='2')or(hodn='3')or(hodn='4')or(hodn='5')or(hodn='6')or(hodn='7')or(hodn='8');
            pideal[pozice]:=hodn;
          until pozice=36;
       end;
       end;

procedure poleidealrnd;
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            pideal[pozice]:=rnd(vstup);
          until pozice=36;
          end;

procedure vyberidealpole;
         begin
         repeat
         clrscr;
         logoprogramu;
         writeln;
         write(' Chcete zadat pole cisel (jinak bude nahodne), [A/N]: ');
         hodnota:=readkey;
         until (hodnota='a') or (hodnota='n');
         if hodnota='a' then
            begin
            poleideal;
            end
          else
            begin
            poleidealrnd;
            end;
         end;

procedure polepotomeknakrm;
          begin
          cislopotomek:=0;
          repeat
            cislopotomek:=cislopotomek+1;
            pozice:=0;
            repeat
              pozice:=pozice+1;
              ppotomek[cislopotomek,pozice]:=rnd(vstup);
            until pozice=36;
          until cislopotomek=6;
          end;

procedure polevyhodnot;
          begin
          cislopotomek:=0;
          repeat
          cislopotomek:=cislopotomek+1;
            pozice:=0;
            tmp:=0;
            repeat
              pozice:=pozice+1;
              if ppotomek[cislopotomek,pozice]=pideal[pozice] then tmp:=tmp+1;
            until pozice=36;
          pshoda[cislopotomek]:=tmp;
          until cislopotomek=6;

  psrovnane[1]:=pshoda[1];
  psrovnane[2]:=pshoda[2];
  psrovnane[3]:=pshoda[3];
  psrovnane[4]:=pshoda[4];
  psrovnane[5]:=pshoda[5];
  psrovnane[6]:=pshoda[6];

  tmp:=0;
  repeat
  tmp:=tmp+1;
  i:=0;
    repeat
    i:=i+1;
    if psrovnane[i]=psrovnane[i+1] then
       begin
       end
     else
       begin
         if psrovnane[i]<psrovnane[i+1] then
            begin
            odloz:=psrovnane[i+1];
            psrovnane[i+1]:=psrovnane[i];
            psrovnane[i]:=odloz;
            end;
       end;
    until i=6;
  until tmp=6;

  tmp:=0;
  repeat
  tmp:=tmp+1;
  if psrovnane[1]=pshoda[tmp] then
     begin
     prvni:=tmp;
     end;
  until (tmp=6) or (psrovnane[1]=pshoda[tmp]);

  tmp:=0;
  repeat
  tmp:=tmp+1;
  if psrovnane[2]=pshoda[tmp] then
     begin
     druhy:=tmp;
     end;
  until (tmp=6) or (psrovnane[2]=pshoda[tmp]);

  tmp:=0;
  repeat
  tmp:=tmp+1;
  if psrovnane[5]=pshoda[tmp] then
     begin
     predposledni:=tmp;
     end;
  until (tmp=6) or (psrovnane[5]=pshoda[tmp]);

  tmp:=0;
  repeat
  tmp:=tmp+1;
  if psrovnane[6]=pshoda[tmp] then
     begin
     posledni:=tmp;
     end;
  until (tmp=6)or(psrovnane[6]=pshoda[tmp]);

  if prvni=posledni then
     begin
     prvni:=1;
     druhy:=2;
     predposledni:=5;
     posledni:=6;
     end;
          end;

procedure potomci;
          begin
          pozice:=0;
          repeat
            pozice:=pozice+1;
            if ppotomek[prvni,pozice]=ppotomek[druhy,pozice] then
               begin
               ppotomek[posledni,pozice]:=ppotomek[prvni,pozice];
               end
             else
               begin
               ppotomek[posledni,pozice]:=rnd(vstup);
               end;
          until pozice=36;
for pozice:=0 to mutuj do begin;ppotomek[posledni,(random(35)+1)]:=rnd(vstup);end;

          pozice:=0;
          repeat
            pozice:=pozice+1;
            if ppotomek[prvni,pozice]=ppotomek[druhy,pozice] then
               begin
               ppotomek[predposledni,pozice]:=ppotomek[prvni,pozice];
               end
             else
               begin
               ppotomek[predposledni,pozice]:=rnd(vstup);
               end;
          until pozice=36;
for pozice:=0 to mutuj do begin;ppotomek[posledni,(random(35)+1)]:=rnd(vstup);end;
          end;

procedure testideal;
          begin
          textcolor(28);
          write('          -- !!! Nalezen idelani jedinec pri ');
          textcolor(14);
          write(kroku);
          write('.');
          textcolor(28);
          writeln(' generaci !!! ---');
          textcolor(7);
          end;

function testidealok:boolean;
          begin
          testidealok:=false;
          if psrovnane[1]=36 then testidealok:=true;
          end;

begin
randomize;
repeat
clrscr;
logoprogramu;
vyberslozitost;
vybermutuj;
vyberidealpole;
polepotomeknakrm;
polevyhodnot;

kroku:=0;
 repeat
  repeat
  clrscr;
  logoprogramu;
  poleukaz;
  writeln;
  writeln;
  writeln('     Zadejte pocet kroku:    N - do stisku klavesy      2 -  100 kroku');
  writeln('                             0 -  1 kroku               3 -  500 kroku');
  writeln('     -- [Konec/Znovu] --     1 - 10 kroku               4 - 1000 kroku');
  writeln;
  if testidealok=true then
     begin
     testideal;
     end
   else
     begin
     writeln(' Jiz generace: ',kroku,'.                      |                Pocet mutaci: ',mutuj);
     end;
  write(' Vase volba: ');
  volba:=readkey;
  until (volba='z')or(volba='n')or(volba='0')or(volba='1')or(volba='2')or(volba='3')or(volba='4')or(volba='k');

 if volba='n' then
   begin
   repeat
   kroku:=kroku+1;
   potomci;
   polevyhodnot;
   gotoxy(16,23);write(kroku);
   until (keypressed) or (testidealok=true);
   volba:=' ';
   end;

 if volba='0' then
   begin
   cyklus:=0;
   repeat
   cyklus:=cyklus+1;
   kroku:=kroku+1;
   potomci;
   polevyhodnot;
   gotoxy(16,23);write(kroku);
   volba:=' ';
   until (cyklus=1) or (testidealok=true);
   end;

 if volba='1' then
   begin
   cyklus:=0;
   repeat
   cyklus:=cyklus+1;
   kroku:=kroku+1;
   potomci;
   polevyhodnot;
   gotoxy(16,23);write(kroku);
   volba:=' ';
   until (cyklus=10) or (testidealok=true);
   end;

 if volba='2' then
   begin
   cyklus:=0;
   repeat
   cyklus:=cyklus+1;
   kroku:=kroku+1;
   potomci;
   polevyhodnot;
   gotoxy(16,23);write(kroku);
   volba:=' ';
   until (cyklus=100) or (testidealok=true);
   end;

 if volba='3' then
   begin
   cyklus:=0;
   repeat
   cyklus:=cyklus+1;
   kroku:=kroku+1;
   potomci;
   polevyhodnot;
   gotoxy(16,23);write(kroku);
   volba:=' ';
   until (cyklus=500) or (testidealok=true);
   end;

   if volba='4' then
   begin
   cyklus:=0;
   repeat
   kroku:=kroku+1;
   cyklus:=cyklus+1;
   potomci;
   polevyhodnot;
   gotoxy(16,23);write(kroku);
   volba:=' ';
   until (cyklus=1000) or (testidealok=true);
   end;

 until (volba='k') or (volba='z');
until volba='k';

clrscr;
logoprogramu;
textcolor(7);
end.