Eugeniusz Jakubas
programy źródłowe w Pascalu

Stąd można pobrać teksty źródłowe poniższych 57 programów w Pascalu pr-pascal.zip - 34 kB

19. Permutacje

program Permutacje;
uses crt;
var n,k,dl_slowa,il_permut,spr,poz,i,max:longInt;
    slowo_wyj,slowo_0,slowo,slowo_st:string;
    x:char;
    t:array[1..255] of integer;
    key:char;
const slowo_max:string='abcdefghijklmnoprstuvwxyz';
procedure sprawdz_i_wstaw(x:char;nr:integer);
begin
  for k:=poz to dl_slowa do
  if (slowo_st[k]=x) and (t[ord(x)]=0)
     then begin
            slowo[nr]:=x; spr:=1;
            t[ord(x)]:=1;
          end;
end;
begin
  clrScr;
  slowo_0:='AABEGLR';
  dl_slowa:=length(slowo_0);
  slowo:=copy(slowo_max,1,dl_slowa);
  slowo_st:=slowo;
  il_permut:=1;
  writeLn(il_permut,'. ',slowo_0);
  max:=1; for n:=1 to dl_slowa do max:=max*n;
  repeat
    for n:=1 to 255 do t[n]:=0;
    n:=1;
    while slowo[dl_slowa-n]>slowo[dl_slowa-n+1] do n:=n+1;
    poz:=dl_slowa-n;
    i:=0;
    spr:=0;
    repeat
      x:=char(ord(slowo[poz])+1+i);
      sprawdz_i_wstaw(x,poz);
      i:=i+1;
    until spr=1;
    x:='!';
    for n:=1 to dl_slowa-poz do
    begin
      i:=0;
      spr:=0;
      repeat
        x:=char(ord(x)+1);
        sprawdz_i_wstaw(x,poz+n);
        i:=i+1;
      until spr=1;
    end;
    il_permut:=il_permut+1;
    slowo_wyj:='';
    for i:=1 to dl_slowa do slowo_wyj:=slowo_wyj+slowo_0[ord(slowo[i])-96];
    writeLn(il_permut,'. ',slowo_wyj);
    slowo_st:=slowo;
{    key:=readKey;}
  until (slowo_wyj='ALGEBRA') or (il_permut=max);
  readLn;
end.