1,2,3,4,5,6 - Reihenfolgen

[Gast]

Hallo Sharky,

das geht leider nicht... sonnst würde meine Anwendung zu lange laufen...

und im Übrigem muss die sehr flexibel sein... also mit angaben von Zahlen...

Gruß

Paul Jr.

[danielA]

Hallo PaulJr,

wenn du bis heute Abend warten kannst, kann ich dir eine Musterlösung in Pascal zuschicken.

Gruß danielA

[Gast]

Daniel hervorragend!!!

Ich wäre Dir SEHR dankbar!

Vielleicht könntest Du die Ausgabe ganz einfach in ein Listbox (z.B.: ListBox1) umleiten...aber es muss nicht sein...


Gruß und vielen, vielen Dank 8)

Paul Jr.

[danielA]

Hallo PaulJr,

ich stelle folgenden Code mal so in den Raum.
der Quellcode ist nicht kommentiert, ich bitte um Nachsicht, habe meinen Anschiß dafür auch bekommen .

Delphi-Quellcode:

vunit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  PermuteList = ^OpenArr;
  OpenArr = Record
     Elem : String;
     Next : PermuteList;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    Function Permute(N: Integer):PermuteList;
    Procedure DeleteList(Liste: PermuteList);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure TForm1.DeleteList(Liste: PermuteList);
var HilfsZeiger: PermuteList;
begin
  if Liste<>nil then
  begin
    HilfsZeiger:=Liste;
    while HilfsZeiger^.Next<>Nil do
    begin
      Liste:=HilfsZeiger^.Next;
      HilfsZeiger^.Next:=nil;
      dispose(HilfsZeiger);
      HilfsZeiger:=Liste;
    end;
    Liste:=nil;
    dispose(Hilfszeiger);
    HilfsZeiger:=nil;
  end;
end;



Function TForm1.Permute(N: Integer):PermuteList;

   Function GetElems(Wert : String;Start,Stop : integer):String;
    var Rueckgabe : string;
    begin
      Rueckgabe:='';
      GetElems:='';
      if (Start<=Stop) and (Start>0) then
      begin
        while (Start>1) and (Pos(',',Wert)>0) do
        begin
          Delete(Wert,1,Pos(',',Wert));
          Dec(Start);
          Dec(Stop);
        end;
        if Start=1 then
        begin
          while (Stop>=1) and (Wert<>'') do
          begin
            if Pos(',',Wert)>0 then
            begin
              Rueckgabe:=Rueckgabe+','+Copy(Wert,1,Pos(',',Wert)-1);
              Delete(Wert,1,Pos(',',Wert));
              Dec(Stop)
            end else
            begin
              Rueckgabe:=Rueckgabe+','+Wert;
              Wert:='';
              Dec(Stop);
            end;
          end;
        end;
      end;
      Delete(Rueckgabe,1,1);
      GetElems:=Rueckgabe;
    end;


Var I,K: integer;
    N_As_String,Element : String;
    OLD_InternList, OLD_LaufList : PermuteList;
    NEW_InternList, NEW_LaufList : PermuteList;

begin
  Permute:=Nil;
  New_InternList:=Nil;
  IF N<=2 then
  begin
    If N=2 then
    begin
      new(New_InternList);
      NEW_InternList^.Elem:='1,2';
      new(NEW_InternList^.Next);
      NEW_InternList^.Next^.Elem:='2,1';
      NEW_InternList^.Next^.Next:=nil;
      Permute:=NEW_InternList;
      NEW_InternList:=Nil;
    end else
    if N=1 then
    begin
      new(NEW_InternList);
      NEW_InternList^.Elem:='1';
      NEW_InternList^.Next:=Nil;
      Permute:=NEW_InternList;
      NEW_InternList:=Nil;
    end else
    begin
      Permute:=nil;
    end;
  end else
  begin
    STR(N,N_As_String);
    OLD_InternList:=Permute(N-1);
    If OLD_InternList<>Nil then
    begin
      OLD_LaufList:=OLD_InternList;
      while OLD_LaufList^.Next<>Nil do
      begin
        if NEW_InternList=Nil then
        begin
          new(NEW_InternList);
          NEW_InternList^.Elem:=N_As_String+','+OLD_LaufList^.Elem;
          OLD_LaufList:=OLD_LaufList^.Next;
          NEW_InternList^.next:=Nil;
          NEW_LaufList:=NEW_InternList;
        end else
        begin
          new(NEW_LaufList^.Next);
          New_LaufList:=New_LaufList^.Next;
          New_LaufList^.Elem:=N_As_String+','+OLD_LaufList^.Elem;
          OLD_LaufList:=OLD_LaufList^.Next;
          NEW_LaufList^.Next:=Nil;
        end;
      end;
      { f�r letztes Element in Old_LaufList }
      if NEW_InternList=Nil then
      begin
        new(NEW_InternList);
        NEW_InternList^.Elem:=N_As_String+','+OLD_LaufList^.Elem;
        NEW_InternList^.next:=Nil;
        NEW_LaufList:=NEW_InternList;
      end else
      begin
        new(NEW_LaufList^.Next);
        New_LaufList:=New_LaufList^.Next;
        New_LaufList^.Next:=nil;
        New_LaufList^.Elem:=N_As_String+','+OLD_LaufList^.Elem;
      end;

      For I:=2 to N do
      begin
        OLD_LaufList:=OLD_InternList;
        while OLD_Lauflist^.Next<>Nil do
        begin
          new(New_LaufList^.Next);
          New_LaufList:=New_LaufList^.Next;
          New_LaufList^.Elem:=#13#10;
          New_LaufList^.Elem:=GetElems(OLD_Lauflist^.Elem,1,i-1)+','+N_As_STRING+','+GETElems(Old_Lauflist^.Elem,i,N);
          if Copy(New_LaufList^.Elem,1,1)=',' then Delete(New_LaufList^.Elem,1,1);
          if Copy(New_LaufList^.Elem,Length(New_LaufList^.Elem),1)=',' then
             Delete(New_LaufList^.Elem,Length(New_LaufList^.Elem),1);
          Old_Lauflist:=Old_LaufList^.Next;
        end;
        new(New_LaufList^.Next);
        New_LaufList:=New_LaufList^.Next;
        New_LaufList^.Elem:=GetElems(OLD_Lauflist^.Elem,1,i-1)+','+N_As_STRING+','+GETElems(Old_Lauflist^.Elem,i,N);
        if Copy(New_LaufList^.Elem,1,1)=',' then Delete(New_LaufList^.Elem,1,1);
        if Copy(New_LaufList^.Elem,Length(New_LaufList^.Elem),1)=',' then
           Delete(New_LaufList^.Elem,Length(New_LaufList^.Elem),1);
      end;
      NEW_LaufList^.Next:=nil;
      OLD_LaufList^.Next:=nil;
      Permute:=NEW_InternList;
      NEW_LaufList:=Nil;
      Old_LaufList:=Nil;
      DeleteList(Old_InternList);
    end;
  end;
end;


{Hauptprogramm}

procedure TForm1.Button1Click(Sender: TObject);
var AusgabeListe,LaufListe : PermuteList;
    i : integer;
    n : integer;
begin
  ListBox1.Clear;
  AusgabeListe:=nil;
  n:=StrToInt(Edit1.Text);
  AusgabeListe:=Permute(n);
  i:=0;
  if Ausgabeliste<>nil then
  begin
    LaufListe:=AusgabeListe;
    while LaufListe^.Next<>nil do
    begin
    //  Writeln('['+LaufListe^.Elem+']');
      ListBox1.Items.Add(laufliste^.Elem);
      Laufliste:=LaufListe^.Next;
      inc(i);
    end;
    //  writeln('['+LaufListe^.Elem+']');
    ListBox1.Items.Add(laufliste^.Elem);
    inc(i);
    LaufListe:=nil;
    DeleteList(AusgabeListe);
  end;
  ShowMessage(inttostr(i) + ' Permutationen gefunden !!!');
end;

end.

er arbeitet aber ebenfalls mit Strings. Die Elemente sind durch das Dezimalsystem vorgegeben sonst funzt die Rekursion in Permute nicht. Ich weiß nun nicht ob du damit was anfangen kannst, oder was du damit vorhast. Aber bedenke, Permute(10) erzeugt bereits 3628800 Permutationen und dauert dementsprechend. Das war mal einen Hausaufgabe an der UNI Die versprochene Musterlösung ist in MODULA2 geschrieben, müßte ich also erst übersetzen. Sie arbeitet aber nach dem selben Prinzip, allerdings mit einem festen Array.Ist also unkomfortabler.

Grüße aus Hamburg

Daniel A

[Gast]

Hallo Daniel

zuerst vielen, vielen für Deine Hilfe...

TOLL!!!

Ich werde es Morgen ausprobieren und mich noch einmal hier melden...

Bin wirklich beeindruckt!

Gruß und Danke

Paul Jr.

[Gast]

Hallo Daniel ,

wie schon gestern gesagt bin ich sehr beeindruckt... ... werde ich es heute ausprobieren und mich hier melden.

Gruß

Paul Jr.

[Gast]

Hallo Daniel ,

also ich bin soweit...

Es läuft hervorragend... Kompliment... genau das was ich gesucht habe!!!

Herzliche Grüße

Paul Jr.

[negaH]

Hi

Hier mal meine Lösung

Delphi-Quellcode:

procedure Combi(const Value: String; List: TStrings);

  procedure DoCombi(Pattern,Pos,Stop: PChar);
  // Erzeuge alle Kombinationen ohne Duplikate (Permutationen) aus Pattern von der
  // Zeichenposition Pos angefangen bis zur Zeichenposition Stop.
  // Pattern muß alpha. sortiert sein.
  // 'AABCDEEXYZ' ist korrekt, aber 'KABA..' ist falsch.
  // Pattern enthält nach Rückkehr von DoCombi() wieder die ursprüngliche
  // Sortierung, wird aber während der Rekursion modifiziert.
  // Die Kombinationen werden alpha. aufsteigend enumeriert.
  var
    Cur: PChar;
    Tmp,Last: Char;
  begin
    if Pos >= Stop then
    begin
      List.Add(Pattern);
      Exit;
    end;
    Last := #0;
    Cur := Pos;
    while Cur <= Stop do
    begin
      Tmp := Cur^; Cur^ := Pos^; Pos^ := Tmp;
      if Tmp > Last then
      // verhindere Duplikate !
      // Falls alle Kombinationen, inklusive Duplikate enumeriert werden sollen
      // muß diese Abfrage entfernt werden. Die Restriktion der alpha. Sortierung
      // ist dann auch nicht mehr erforderlich.
      begin
        DoCombi(Pattern, Pos +1, Stop);
        Last := Tmp;
      end;
      Inc(Cur);
    end;
    Tmp := Pos^;
    while Pos < Stop do
    begin
      Pos^ := Pos[1];
      Inc(Pos);
    end;
    Pos^ := Tmp;
  end;

var
  Temp: String;
begin
  Temp := Value;
  UniqueString(Temp);
  DoCombi(@Temp[1], @Temp[1], @Temp[Length(Temp)]);
end;

procedure Test;
var
  List: TStringList;
begin
  List := TStringList.Create;
  try
    Combi('123456', List);
    WriteLn(List.Text);
  finally
    List.Free;
  end;
end;

Sie ist ein bischen weniger aufwendig und arbeitet inplaced.

Oder hier Kombination und Permutation von Strings/Integern

Gruß Hagen

[Gast]

Ups...

Hallo Hagen 8) ,

erst jetzt sehe ich, dass Du auch was aus Deiner Zauberkiste herausgezogen hast...

Besten Dank

Dies habe ich natürlich auch sofort in meine Unit integriert.

Ich benutze aber weiter die Routine von Daniel... aber man weiß es nie...

Also noch einmal Besten Dank an Euch beiden Profis...

Gruß

Paul Jr.