Program na simuláciu permutácií pre zadaný počet prvkov

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija: KMP (Programy mladňakoch

Zrobil: Ján Benkovič
web: www.tbteacher.host.sk

Program: Permutacie.pas
Subor exe: Permutacie.exe
Ukažka: Permut.txt

Program na simuláciu permutácií pre zadaný počet prvkov.
{ PERMUTACIE.PAS                         Copyright (c) Jan Benkovic }
{ Program na simulaciu permutacii pre zadany pocet prvkov.          }
{                                                                   }
{ Datum:18.03.2002                             http://www.trsek.com }
 
uses crt;
 
var n,i,ia:byte;
    c2,c,c1:longint;
    a:array[0..10] of char;
    as:array[0..10] of char;
    ac:array[0..10] of byte;
    s,ch,s1:string;
    code,poc:integer;
    t:text;
 
begin
 clrscr;
 assign(t,'Permut.txt');
 rewrite(t);
 writeln(t,'Permutacie');
 
 writeln('Program na simulaciu permutacii');
 writeln('Zadaj pocet prvkov');
 readln(n);
 
 c1:=0; c:=1;
 for i:= n downto 1 do
  begin
    c1:=i*c+c1;
    c:=10*c;                   {urcenie zaciatku napr 12345e}
  end;
 writeln(c1);
 
 
 c2:=0; c:=1;
 for i:= 1 to n do
  begin
    c2:=i*c+c2;                {urcenie konca napr 54321}
    c:=10*c;
    a[i]:=char(64+i);          {ABCDE.....}
  end;
 writeln(c2);
 
 repeat
 
  s:='';
  s1:='';
  poc:=0;
  str(c1,s);                   {cislo->retazca   napr 12345 -> '12345' }
 
  for i:= 1 to n do
   begin                       {postupne nacitavanie jed cislic}
     ch:=copy(s,i,1);          {string->cislo napr '1' -> 1 }
     val(ch,ac[i],code);
     s1:=concat(s1,a[ac[i]]);  {spajanie podla cislic z povodneho ABCD...}
 
 
     if (ac[i]>n) or (ac[i]<=0) then
        poc:=1                 {vylucenie 0 a cisel >ako si zadal}
   end;
  c1:=c1+9;
 
  for i:= 1 to n do
   begin
     ia:=i+1;
     while ia<=n do
      begin
       if ac[i]=ac[ia] then poc:=1;       {vylucenie opakujucich sa cisel}
       inc(ia);
     end;
   end;
 
  if poc<>1 then
     writeln(t,s1,' ');
                                             {hotovo}
 until c1>c2;
 
 close(t);
 writeln('Koniec - stlac enter');
 readkey;
end.