Wszystkie mo?żliwości

0

Mam taki problem:
Chce napisać program, który wypisuje wszystkie mozliwosci z danego zbioru
np.: podaje programowi a-zbior elementów, b-ilosc elementow w kombinacji
jesli a to {a,b,c,d}, b=3 to program ma wypisać wszystkie kombinacje tych elementow ale w zakresie b:

a,b,c
a,b,d
c,a,d
d,a,c
b,d,a

itd...

0
type charset=set of char;

function incs(var s:string;j:integer;min,max:char;var a:charset):boolean;
var b:boolean;
begin
  b:=false;
  if s[j]=max
    then
      begin
        if j>1
          then b:=incs(s,j-1,min,max,a)
          else b:=true;
        s[j]:=min;
      end
    else
      repeat
        inc(byte(s[j]))
      until s[j] in a;
  incs:=b;
end;

var
  a:charset;
  i,j,k:integer;
  s:string;
  min,max:char;
begin

  {inicjacja}

  min:=#255;
  max:=^@;
  a:=[];

  {pobieranie danych}

  write('podaj znaki do losowania : ');
  readln(s);
  if length(s)<1 then
    begin
      writeln('a z czego mam niby losowac ?');
      halt
    end;
  write('podaj ilosc pol : ');
  readln(j);
  if j<1 then
    begin
      writeln('o pol ? malo bystre !');
      halt
    end;

  {przygotowanie danych do obrobki}

  for i:=1 to length(s)do
    begin
      if min>s[i] then min:=s[i];
      if max<s[i] then max:=s[i];
      a:=a+[s[i]];
    end;
  s:='';
  for i:=1 to j do s:=s+min;

  {petla glowna}

  {** odkomentuj o zobacz roznice
  k:=j;
  j:=1;
  s:=min;
  while j<=k do
    begin}


      repeat
        writeln(s);
      until incs(s,j,min,max,a);

      {inc(j);
      s:=min+s
    end;}

end.

Przy okazji wypisuje alfabetycznie

0

Jeszcze nie sprawdziłem ale z góry ci dziekuje :)

1 użytkowników online, w tym zalogowanych: 0, gości: 1