Delphi-PRAXiS
Seite 2 von 3     12 3      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Lazarus (IDE) (https://www.delphipraxis.net/81-lazarus-ide/)
-   -   Grafische Lösung der Türme von Hanoi (Rekursion) (https://www.delphipraxis.net/188246-grafische-loesung-der-tuerme-von-hanoi-rekursion.html)

Mavarik 14. Feb 2016 11:42

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Zitat:

Zitat von Hanoi1 (Beitrag 1330283)
Über die Array-Shapes habe ich auch nachgedacht, diese aber wieder verworfen, weil ich diesen Algorithmus in möglichst kurzer Zeit erklären muss - und mein Publikum hat keine Ahnung von Arrays (kein Witz). Darum würde nur zusätzlicher Erklärungsbedarf entstehen...

Das Satz das ist eine Liste der Shapes ist zu lang?

Zitat:

Zitat von Hanoi1 (Beitrag 1330283)
Die Sache mit der Variablen ist zwar auch eine Möglichkeit, aber direkt vereinfachen würde es mein Problem ja nicht.

Macht aber den Code "richtig"

Zitat:

Zitat von Hanoi1 (Beitrag 1330283)
Die Anmerkung zu meiner Schleife ist allerdings berechtigt. Danke!

Nur das?

Mit den Sourceocode würdest Du bei mir durchfallen...

Hanoi1 14. Feb 2016 15:13

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Ich habe die Vorschläge jetzt eingearbeitet und verwende statt des sleeps jetzt einen Timer.

Wie zu erwarten war, wird die Rekursion im Hauptprogramm jetzt normal ausgeführt, während die Bewegung durch den Timer "hinterherhängt".
Wie schaffe ich es jetzt, dass das Hauptprogramm sozusagen auf den Timer wartet?

Außerdem gibt es noch ein kleineres Definitions problem in der Timersequenz. Wie kann ich das beheben?

Hier mein neuer Code:
Delphi-Quellcode:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    PaintBox1: TPaintBox;
    Links: TShape;
    Rechts: TShape;
    Mitte: TShape;
    ShapeMOVE: TShape;
    TA: TShape;
    TB: TShape;
    TC: TShape;
    ShapeMF: TShape;
    ShapeMT: TShape;
    ShapeT2: TShape;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
    z: integer;
    q: boolean;
    cL,cM,cR: integer;
    Scheibe: array[1..10] of TShape;
    Tr: integer;

implementation

{$R *.lfm}

{ TForm1 }

procedure draw(a,b,c,d: integer; n: string);
var Shape : TShape;
begin
 Shape := TShape.Create(Form1);
 With Shape do
  begin
   Parent := Form1;
   Left := a;
   Top := b;
   Width:= c;
   Height:=d;
   Name := n;
  end;
end;

procedure Ground(e,f: integer);
begin
 draw(100,550,e,f,'Links');
 draw(400,550,e,f,'Mitte');
 draw(700,550,e,f,'Rechts');
end;

procedure towerA(t: integer);
var i,z: integer;
begin
 i:=0;
 z:=t+1;
 repeat
  i:=i+1;
  z:=z-1;
  Scheibe[t] := TShape.Create(Form1);
 With Scheibe[t] do
  begin
   Parent := Form1;
   Left := 100+((i-1)*10);
   Top := 550-(i*50);
   Width:= 200-((i-1)*20);
   Height:=50;
  end;
 until i=t;
end;

procedure movetop(r: integer;ShapeMF,ShapeMT: TShape);
begin
 Tr:=r;
 Form1.ShapeT2:=ShapeMT;
 if ShapeMT.left=Form1.Mitte.left then
 begin
    cM:=cM+1;
    z:=550-(cM*50);
 end;
 if ShapeMT.left=Form1.Links.left then
 begin
    cL:=cL+1;
    z:=550-(cL*50);
 end;
 if ShapeMT.left=Form1.Rechts.left then
 begin
    cR:=cR+1;
    z:=550-(cR*50);
 end;
 if ShapeMF.left=Form1.Mitte.left then
 begin
    cM:=cM-1;
 end;
 if ShapeMF.left=Form1.Links.left then
 begin
    cL:=cL-1;
 end;
 if ShapeMF.left=Form1.Rechts.left then
 begin
    cR:=cR-1;
 end;
 Form1.Timer1.Enabled:=true;
end;

procedure rec(r: integer;TA,TB,TC: TShape);
begin
 if r>0 then
 begin
   rec(r-1,TA,TC,TB);
   movetop(r,TA,TC);
   rec(r-1,TB,TA,TC);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var k: Integer;
begin
 k:=StrToInt(Edit1.Text);
 Label1.caption:= 'Scheiben';
 cL:= k;
 cM:= 0;
 cR:= 0;
 Ground(200,50);
 towerA(k);
end;

procedure TForm1.Button2Click(Sender: TObject);
var k: Integer;
begin
 k:=StrToInt(Edit1.Text);
 q:=true;
 rec(k,Links,Mitte,Rechts);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if q=true then
 begin
    if Scheibe[Tr].Top > 50 then
    Scheibe[Tr].Top:=Scheibe[Tr].Top-10;
 end;
 if Scheibe[Tr].Top=50 then
 begin
   if Scheibe[Tr].Left > ShapeT2.Left+((200-Scheibe[Tr].width)DIV 2) then
      Scheibe[Tr].Left:=Scheibe[Tr].Left-10;
   if Scheibe[Tr].Left < ShapeT2.Left+((200-Scheibe[Tr].width)DIV 2) then
      Scheibe[Tr].Left:=Scheibe[Tr].Left+10;
 end;
 if Scheibe[Tr].Left = ShapeT2.Left+((200-Scheibe[Tr].width)DIV 2) then
 begin
   q:=false;
   if Scheibe[Tr].Top < z then
    Scheibe[Tr].Top:=Scheibe[Tr].Top +10;
   if Scheibe[Tr].Top = z then
    q:=true;
    Timer1.Enabled:=false;
 end;
end;

end.

stahli 14. Feb 2016 15:24

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Mit Deinem Code kann ich mich jetzt nicht weiter befassen, aber schreib doch erst mal ein kleines Testprogramm, in dem Du ein Panel verschieben lässt.

Delphi-Quellcode:
for I := 0 to 1000 do
begin
  Panel.Left := I;
  Sleep(500);
end;
Die Schleife wird das Panel zwar verschieben, aber das Formular kommt nicht dazu, jeden Zwischenschritt anzuzeigen.
Du brauchst daher nach der Positionszuweisung ein Application.Processmessages.

Mein Tipp, versuche erst mal ein kleines Minimalprojekt um zu prüfen, wo das Problem genau liegt.

Mavarik 14. Feb 2016 16:31

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Na das sieht doch schon ganz anders aus...

Leider hast Du immer noch nicht die proceduren in der Form definiert, deswegen muss du immer noch

Delphi-Quellcode:
Form1.Timer1.Enabled:=true;

schreiben.

Auch wenn ich das so nie programmieren würde, könntest Du an dieser Stelle schreiben:

Delphi-Quellcode:
Form1.Timer1.Enabled:=true;

While Form1.Timer1.Enabled = true do
begin
  Application.Processmessages;
  Sleep(10);
end;
Das Erzeugen der Scheiben ist falsch [t] ??? Vielleicht [i]?

Die Animation funktioniert auch nicht... Weil Du den Timer zu früh abschaltest...

Mavarik 14. Feb 2016 20:42

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Liste der Anhänge anzeigen (Anzahl: 1)
So würde ich das machen...

Hanoi1 14. Feb 2016 22:18

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Wie rufe ich den Code dafür ab?

Mavarik 15. Feb 2016 11:37

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Zitat:

Zitat von Hanoi1 (Beitrag 1330340)
Wie rufe ich den Code dafür ab?

Die wesentlichen Teilen:

Delphi-Quellcode:
unit Main;


interface

uses
...

const
  Größe    = 250.0;
  MaxHeight = 240;
  Dauer    = 1;
  Dicke    = 25;

type
  TZug = record
    Von, Nach: integer;
    constructor Create( AVon, ANach: integer );
  end;

  TKindOfAnimation = ( Up, RightOrLeft, Down, Next );

  TForm128 = class( TForm )
..
  private
    { Private-Deklarationen }
    Scheiben   : array of TRectangle;
    Pole       : array [ 1 .. 3 ] of TPointF;
    Stange     : array [ 1 .. 3 ] of TStack<integer>;
    Colors     : array [ 0 .. 9 ] of TAlphaColor;
    Zugliste   : TQueue<TZug>;
    ScheibenNr : integer;
    AktAnimation: TKindOfAnimation;
    AktZug     : TZug;

    procedure Init( const AAnzahl: integer );
    procedure DeInit;
    procedure dohanoi( Anzahl, AFrom, ATo, ASave: integer );
    procedure ShowZüge;
    function GetZug( out AZug: TZug ): boolean;
    procedure ShowZug( AZug: TZug );
    procedure Animation( AKind: TKindOfAnimation );
    function GetColor( A, B: integer ): TAlphaColor;
  public
    { Public-Deklarationen }
  end;

implementation

{$R *.fmx}

procedure TForm128.dohanoi( Anzahl, AFrom, ATo, ASave: integer );
begin
  if Anzahl > 0
  then
    begin
      dohanoi( Anzahl - 1, AFrom, ASave, ATo );
      Zugliste.Enqueue( TZug.Create( AFrom, ATo ) );
      dohanoi( Anzahl - 1, ASave, ATo, AFrom );
    end
end;

procedure TForm128.FloatAnimation1Finish( Sender: TObject );
begin
  AktAnimation := Succ( AktAnimation );
  if AktAnimation = Next
  then
    begin
      Application.ProcessMessages;
      ShowZüge;
    end
  else
    Animation( AktAnimation );
end;

procedure TForm128.FormCreate( Sender: TObject );
begin
  Colors[ 0 ] := TAlphaColorRec.Black;
  Colors[ 1 ] := TAlphaColorRec.Darkviolet;
  Colors[ 2 ] := TAlphaColorRec.Blue;
  Colors[ 3 ] := TAlphaColorRec.Deepskyblue;
  Colors[ 4 ] := TAlphaColorRec.Mediumseagreen;
  Colors[ 5 ] := TAlphaColorRec.Greenyellow;
  Colors[ 6 ] := TAlphaColorRec.Yellow;
  Colors[ 7 ] := TAlphaColorRec.Orange;
  Colors[ 8 ] := TAlphaColorRec.Orangered;
  Colors[ 9 ] := TAlphaColorRec.Red;

  Setlength( Scheiben, 0 );
  TrackBar1.Value := Dauer * 1000;

  Stange[ 1 ] := TStack<integer>.Create;
  Stange[ 2 ] := TStack<integer>.Create;
  Stange[ 3 ] := TStack<integer>.Create;

  Pole[ 1 ].X := Leftpole.Position.X + ( Leftpole.Width / 2 );
  Pole[ 2 ].X := MidPole.Position.X + ( MidPole.Width / 2 );
  Pole[ 3 ].X := RightPole.Position.X + ( RightPole.Width / 2 );

  Init( trunc( SpinBox1.Value ) );
end;


function TForm128.GetColor( A, B: integer ): TAlphaColor;
var
  M: Single;
begin
  if A = 0
  then
    Exit( Colors[ 0 ] );
  if A = B
  then
    Exit( Colors[ 9 ] );

  M := ( 9 / B ) * A;

  Result := Colors[ trunc( M ) ];
end;

function TForm128.GetZug( out AZug: TZug ): boolean;
begin
  if Zugliste.Count > 0
  then
    begin
      AZug  := Zugliste.Dequeue;
      Result := true;
    end
  else
    Result := false;
end;

procedure TForm128.Animation( AKind: TKindOfAnimation );
begin
  AktAnimation := AKind;

  case AKind of
    Up:
      begin
        FloatAnimation1.Stop;
        FloatAnimation1.Parent       := Scheiben[ ScheibenNr ];
        FloatAnimation1.StartValue   := Scheiben[ ScheibenNr ].Position.Y;
        FloatAnimation1.StopValue    := MaxHeight;
        FloatAnimation1.AnimationType := TAnimationType.&In;
        FloatAnimation1.Interpolation := TInterpolationType.Quadratic;
        FloatAnimation1.Start;
      end;
    RightOrLeft:
      begin
        FloatAnimation2.Stop;
        FloatAnimation2.Parent    := Scheiben[ ScheibenNr ];
        FloatAnimation2.StartValue := Scheiben[ ScheibenNr ].Position.X;
        FloatAnimation2.StopValue := Pole[ AktZug.Nach ].X - ( Scheiben[ ScheibenNr ].Width / 2 );
        FloatAnimation2.Start;
      end;
    Down:
      begin
        FloatAnimation1.Stop;
        FloatAnimation1.Parent       := Scheiben[ ScheibenNr ];
        FloatAnimation1.StartValue   := MaxHeight;
        FloatAnimation1.StopValue    := Ground.Position.Y - ( Stange[ AktZug.Nach ].Count * Dicke );
        FloatAnimation1.AnimationType := TAnimationType.Out;
        FloatAnimation1.Interpolation := TInterpolationType.Bounce;
        FloatAnimation1.Start;
      end;
  end; // of case
end;

procedure TForm128.Button1Click( Sender: TObject );
begin
  Button1.Enabled := false;
  SpinBox1.Enabled := false;
  Application.ProcessMessages;

  Init( trunc( SpinBox1.Value ) );

  Zugliste := TQueue<TZug>.Create;
  dohanoi( trunc( SpinBox1.Value ), 1, 3, 2 );

  ShowZüge;
end;

procedure TForm128.DeInit;
begin
  Zugliste.Free;
  FloatAnimation1.Parent := nil;
  FloatAnimation2.Parent := nil;
  Button1.Enabled       := true;
  SpinBox1.Enabled      := true;
end;

procedure TForm128.Init( const AAnzahl: integer );
var
  i                           : integer;
  StartSize, StartStack, DeltaW: Single;
begin
  Stange[ 1 ].Clear;
  Stange[ 2 ].Clear;
  Stange[ 3 ].Clear;

  for i := 0 to high( Scheiben ) do
    Scheiben[ i ].Free;

  StartSize := Größe;
  StartStack := Ground.Position.Y - Dicke;
  Setlength( Scheiben, AAnzahl );

  FloatAnimation1.Duration := TrackBar1.Value / 1000;
  FloatAnimation2.Duration := TrackBar1.Value / 1000;

  DeltaW := 230 / AAnzahl;

  for i := 0 to AAnzahl - 1 do
    begin
      Scheiben[ i ]           := TRectangle.Create( Self );
      Scheiben[ i ].Parent    := Layout1;
      Scheiben[ i ].Height    := Dicke;
      Scheiben[ i ].Width     := StartSize;
      Scheiben[ i ].Position.X := Pole[ 1 ].X - ( StartSize / 2 );
      Scheiben[ i ].Position.Y := StartStack;
      Scheiben[ i ].Fill.Color := GetColor( i, AAnzahl - 1 );
      StartStack              := StartStack - Dicke;
      StartSize               := StartSize - DeltaW;
      Stange[ 1 ].Push( i );
    end;
end;

procedure TForm128.ShowZug( AZug: TZug );
begin
  ScheibenNr := Stange[ AZug.Von ].Pop;
  Stange[ AZug.Nach ].Push( ScheibenNr );

  AktZug := AZug;
  Animation( Up );
end;

procedure TForm128.ShowZüge;
var
  Zug: TZug;
begin
  if GetZug( Zug )
  then
    ShowZug( Zug )
  else
    DeInit;
end;


{ TZug }

constructor TZug.Create( AVon, ANach: integer );
begin
  Von := AVon;
  Nach := ANach;
end;

end.

Hanoi1 15. Feb 2016 22:24

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Mein Programm funktioneirt jetzt endlich. :thumb:
Ich habe auch die Oberfläche nochmal etwas abgeändert und besser gestaltet.

Hier also mein neuer Quellcode:
Delphi-Quellcode:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Rechts: TShape;
    Mitte: TShape;
    Links: TShape;
    StabRechts: TShape;
    StabMitte: TShape;
    StabLinks: TShape;
    ShapeMOVE: TShape;
    TA: TShape;
    TB: TShape;
    TC: TShape;
    ShapeMF: TShape;
    ShapeMT: TShape;
    ShapeT2: TShape;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
    z: integer;
    q: boolean;
    cL,cM,cR: integer;
    Scheibe: array[1..10] of TShape;
    index: integer;

implementation

{$R *.lfm}

{ TForm1 }

procedure draw(a,b,c,d: integer; n: string);
var Shape : TShape;
begin
 Shape := TShape.Create(Form1);
 With Shape do
  begin
   Parent := Form1;
   Left := a;
   Top := b;
   Width:= c;
   Height:=d;
   Name := n;
   Brush.Color:=clMaroon;
   Brush.Style:=bsSolid;
   Pen.Color:=clMaroon;
  end;
end;

procedure towerA(t: integer);
var i,z: integer;
begin
 i:=0;
 z:=t+1;
 repeat
  i:=i+1;
  z:=z-1;
  Scheibe[z] := TShape.Create(Form1);
 With Scheibe[z] do
  begin
   Parent := Form1;
   Left := 100+((i-1)*10);
   Top := 550-(i*50);
   Width:= 200-((i-1)*20);
   Height:=50;
   Name:= 'Scheibe'+IntToStr(z);
   Brush.Color:=clNavy;
   Shape:=stRoundRect;
  end;
 until i=t;
end;

procedure movetop(r: integer;ShapeMF,ShapeMT: TShape);
begin
 index:=r;
 Form1.ShapeT2:=ShapeMT;
 if ShapeMT.left=Form1.Mitte.left then
 begin
    cM:=cM+1;
    z:=550-(cM*50);
 end;
 if ShapeMT.left=Form1.Links.left then
 begin
    cL:=cL+1;
    z:=550-(cL*50);
 end;
 if ShapeMT.left=Form1.Rechts.left then
 begin
    cR:=cR+1;
    z:=550-(cR*50);
 end;
 if ShapeMF.left=Form1.Mitte.left then
 begin
    cM:=cM-1;
 end;
 if ShapeMF.left=Form1.Links.left then
 begin
    cL:=cL-1;
 end;
 if ShapeMF.left=Form1.Rechts.left then
 begin
    cR:=cR-1;
 end;
 Form1.Timer1.Enabled:=true;
 While Form1.Timer1.Enabled = true do
begin
  Application.Processmessages;
  Sleep(10);
end;
end;

procedure rec(r: integer;TA,TB,TC: TShape);
begin
 if r>0 then
 begin
   rec(r-1,TA,TC,TB);
   movetop(r,TA,TC);
   rec(r-1,TB,TA,TC);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 draw(100,550,200,50,'Links');
 draw(400,550,200,50,'Mitte');
 draw(700,550,200,50,'Rechts');
 draw(195,120,10,430,'StabLinks');
 draw(495,120,10,430,'StabMitte');
 draw(795,120,10,430,'StabRechts');
end;

procedure TForm1.Button2Click(Sender: TObject);
var k: Integer;
begin
 k:=StrToInt(Edit1.Text);
 if k > 10 then
    k:=10;
 if k < 3 then
    k:=3;
 q:=true;
 rec(k,Links,Mitte,Rechts);
end;

procedure TForm1.Button3Click(Sender: TObject);
var k: Integer;
begin
 k:=StrToInt(Edit1.Text);
 if k > 10 then
 begin
    k:=10;
    ShowMessage('Achtung: Da die gewünschte Anzahl an Scheiben über dem gültigen Maximalwert liegt, werden 10 Scheiben generiert.');
 end;
 if k < 3 then
 begin
    k:=3;
    ShowMessage('Achtung: Da die gewünschte Anzahl an Scheiben unter dem gültigen Minimalwert liegt, werden 3 Scheiben generiert.');
 end;
 cL:= k;
 cM:= 0;
 cR:= 0;
 towerA(k);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if q=true then
 begin
    if Scheibe[index].Top > 50 then
    Scheibe[index].Top:=Scheibe[index].Top-10;
 end;
 if Scheibe[index].Top=50 then
 begin
   if Scheibe[index].Left > ShapeT2.Left+((200-Scheibe[index].width)DIV 2) then
      Scheibe[index].Left:=Scheibe[index].Left-10;
   if Scheibe[index].Left < ShapeT2.Left+((200-Scheibe[index].width)DIV 2) then
      Scheibe[index].Left:=Scheibe[index].Left+10;
 end;
 if Scheibe[index].Left = ShapeT2.Left+((200-Scheibe[index].width)DIV 2) then
 begin
   q:=false;
   if Scheibe[index].Top < z then
    Scheibe[index].Top:=Scheibe[index].Top +10;
   if Scheibe[index].Top = z then
   begin
    q:=true;
    Timer1.Enabled:=false;
   end;
 end;
end;

end.
An dieser Stelle möchte ich mich ganz sehr bei allen, die mir dabei geholfen haben, bedanken! Ohne euch hätte das sicher nicht geklappt!
:thumb::thumb::thumb:

LG

stahli 15. Feb 2016 22:31

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
:thumb:

Hanoi1 16. Feb 2016 17:38

AW: Grafische Lösung der Türme von Hanoi (Rekursion)
 
Eine Kleinigkeit noch:
Durch

Delphi-Quellcode:
While Form1.Timer1.Enabled = true do
begin
  Application.Processmessages;
  Sleep(10);
end;
friere ich das Programm mit Ausnahme des Timers ein. Ohne das funktioniert der Algorithmus ja auch nicht.

Wenn ich jetzt aber beispielsweise 10 Scheiben generiere und die Lösung aktiviere, dauert das ja seine Zeit, bis das Programm "entfriert".

Darum wollte ich einen neuen Knopf einfügen, der den Timer anhält (z.B.
Delphi-Quellcode:
close;
).
Das geht aber nun natürlich nicht...

Gibt es eine Möglichkeit das umzusetzen?


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:31 Uhr.
Seite 2 von 3     12 3      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz