(Sadeleştirildi) Girilen sayı adedinde iç içe for döngüsü oluşturma

[sabanakman]

İyi günler. İç içe n tane döngü kurmak için aşağıdaki gibi bir sınıf kullanılabilir.

unit untPerm;

interface

uses Classes, SysUtils;

type
  TSayac=class(TComponent)
  private
    FSayac:TSayac;
    FDizi:array of Integer;
    FFarkliSec:Boolean;
    FBoyut:Integer;
    function OkuBoyut: Integer;
    procedure YazBoyut(const Deger: Integer);
    function OkuFarkliSec: Boolean;
    procedure YazFarkliSec(const Deger: Boolean);
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    function Basla(const iBoyut:Integer=-1):Boolean;
    function Sonraki:Boolean;
    function Sirasi(const iYer:Integer):Integer;
    function TekrarliDegerVarmi:Boolean;
    function Sayac(const iBoyut:Integer=-1):TSayac;
  protected
    procedure Boyutlandir;dynamic;
  published
    property Boyut:Integer read OkuBoyut write YazBoyut;
    property FarkliSec:Boolean read OkuFarkliSec write YazFarkliSec;
  end;

implementation

{ TSayac }

function TSayac.Basla(const iBoyut:Integer):Boolean;
var iYer:Integer;
begin
  YazBoyut(iBoyut);
  Result:=True;
  for iYer := 0 to FBoyut - 1 do begin
    if FFarkliSec then FDizi[iYer]:=iYer else FDizi[iYer]:=0;
  end;
end;

procedure TSayac.Boyutlandir;
begin
  SetLength(FDizi, FBoyut);
  Basla;
end;

constructor TSayac.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSayac:=nil;
  FBoyut:=2;
  FFarkliSec:=False;
  Boyutlandir;
end;

destructor TSayac.Destroy;
begin
  SetLength(FDizi, 0);
  FDizi:=nil;
  inherited Destroy;
end;

function TSayac.OkuBoyut: Integer;
begin
  Result:=FBoyut;
end;

function TSayac.OkuFarkliSec: Boolean;
begin
  Result:=FFarkliSec;
end;

function TSayac.Sayac(const iBoyut:Integer): TSayac;
begin
  if not Assigned(FSayac) then
   FSayac:=TSayac.Create(Self);

  Result:=FSayac;

  if iBoyut>1 then
   Result.Boyut:=iBoyut;
end;

function TSayac.Sirasi(const iYer: Integer): Integer;
begin
  if (iYer<0) or (iYer>=FBoyut) then begin
    //raise Exception.CreateFmt('"%d" boyutu aşıyor', [iYer]);
    Result:=-1;
  end else Result:=FDizi[iYer];
end;

function TSayac.Sonraki: Boolean;
var iYer:Integer; bBirak:Boolean;
begin
  Result:=True;
  repeat
    iYer:=FBoyut-1;
    repeat
      bBirak:=True;
      if iYer>=0 then begin
        Inc(FDizi[iYer]);
        if (FDizi[iYer]>=FBoyut) then begin
          FDizi[iYer]:=0;
          Dec(iYer);
          bBirak:=False;
        end;
      end else Result:=False;
    until bBirak or not Result;

    if bBirak and Result and FFarkliSec then begin
      bBirak:=not TekrarliDegerVarmi;
    end;
  until bBirak or not Result;
end;

function TSayac.TekrarliDegerVarmi: Boolean;
var iPos, jPos:Integer;
begin
  Result:=False;
  iPos:=0;
  while (iPos<FBoyut-1) and not Result do begin
    jPos:=iPos+1;
    while (jPos<FBoyut) and not Result do begin
      if FDizi[iPos]=FDizi[jPos] then
       Result:=True;
      Inc(jPos);
    end;
    Inc(iPos);
  end;
end;

procedure TSayac.YazBoyut(const Deger: Integer);
begin
  if (Deger>1) and (FBoyut<>Deger) then begin
    FBoyut:=Deger;
    Boyutlandir;
  end;
end;

procedure TSayac.YazFarkliSec(const Deger: Boolean);
begin
  if FFarkliSec<>Deger then begin
    FFarkliSec:=Deger;
    if FFarkliSec and TekrarliDegerVarmi then
     Sonraki;
  end;
end;

end.

Bu sınıfı kullanarak elimize 2 üründe gelse, 8 üründe gelse bir döngü içinde kontrole sokmanın imkanı bulunacaktır.

Sayac:=TSayac.Create(Self);
Sayac.FarkliSec:=True;//aynı ürün tekrar ele alınmayacak
Sayac.Basla(3);//3 tane ürünümüz var ama iç içe 3 for döngüsü kurmaya gerek kalmayacak TSayac sınıfımız sayesinde
ListBox1.Items.Clear;
repeat //ürünlerin sıralanış (permutasyon) döngüsü
   sSatir:='';
   for i := 0 to Sayac.Boyut-1 do begin //sıraya dizilmiş ürünler
      //Sayac.Sirasi(i); -->i. sırada hangi ürün var onun yerini verir ....
      if i=0 then sSatir:=IntToStr(Sayac.Sirasi(i)) else sSatir:=sSatir+' , '+IntToStr(Sayac.Sirasi(i));
   end;
   ListBox1.Items.Add(sSatir);
until not Sayac.Sonraki;

Olayınızı örnek üzerinden tam olarak çözümleyemesemde permutasyon hesaplamada her eleman için iç içe kurulan for döngüsüne yukarıdaki gibi bir çözüm getirebilirsiniz. İyi çalışmalar.