ハノイの塔の解を教えてください

パル 2006-10-07 03:49:50 No: 23498

まったくの初心者です；
Delphi3でハノイの塔の解を求めよ。
という授業課題が出たのですが、何をどうすればいいのか全く検討がつきません。
教えてください(__；)っつ

パル 2006-10-07 04:12:04 No: 23499

Delphi6でした…

なぽれおん 2006-10-07 09:49:35 No: 23500

余(パルさん)の辞書には「検索」という文字はない…のかな？

以下、「解」じゃないけど、見てると面白い？
解を求めるには Mathユニットの IntPower関数が必要と思う。

procedure TForm1.Button1Click(Sender: TObject);
const
  NumDisk = 7;  // 円盤の枚数
  SrcPole = 1;  // 最初の柱番号
  DstPole = 3;  // 目的の柱番号
  C: array[1..7]of TColor  = (clBlue, clRed, clFuchsia, clLime, clAqua, clYellow, clSilver);
  W: array[1..7]of Integer = (20, 30, 40, 50, 60, 70, 80);
  S: array[1..7]of Integer = (30, 25, 20, 15, 10, 5, 0);
  P: array[1..3]of Integer = (10, 90, 170);
var
  h: array[1..3]of Integer;
  x: array[1..7]of Integer;
  y: array[1..7]of Integer;
  i, cnt: Integer;
  procedure Carry(n, a, b: Integer);
  var
    t: Integer;
  begin
    if n > 1 then Carry(n - 1, a, 6 - a - b);
    for t:=1 to 100 do begin
      if Application.Terminated then exit;
        Application.ProcessMessages; Sleep(10);
    end;
    inc(cnt);
    Memo1.Lines.Add(Format('%3d回目：円盤 %d を %d から %d に移す', [cnt, n, a, b]));
    with Image1.Canvas do begin
      Pen.Color := clWhite;
      Brush.Color := clWhite;
      RectAngle(x[n]+S[n], y[n], x[n]+S[n]+W[n], y[n]+10);
      Pen.Color := clBlack;
      Brush.Color := C[n];
      x[n] := P[b];
      y[n] := h[b];
      h[a] := h[a]+10;
      h[b] := h[b]-10;
      RectAngle(x[n]+S[n], y[n], x[n]+S[n]+W[n], y[n]+10);
    end;
    if n > 1 then Carry(n - 1, 6 - a - b, b);
  end;
begin
  Memo1.Clear;
  cnt := 0;
  h[SrcPole] := 10;
  h[SrcPole mod 3 + 1] := 10 + 10 * NumDisk;
  h[(SrcPole+1) mod 3 + 1] := 10 + 10 * NumDisk;
  with Image1.Canvas do begin
    Brush.Color := clWhite;
    RectAngle(0, 0, Width, Height);
    for i:=1 to NumDisk do begin
      x[i] := P[SrcPole];
      y[i] := 10 + i*10;
      Pen.Color := clBlack;
      Brush.Color := C[i];
      RectAngle(x[i]+S[i], y[i], x[i]+S[i]+W[i], y[i]+10);
    end;
  end;
  TButton(Sender).Caption := 'Trying';
  Carry(NumDisk, SrcPole, DstPole);
  TButton(Sender).Caption := 'Finish';
end;

ユコウ 2006-10-07 12:50:55 No: 23501

質問者ではないのですが便乗して…

procedure Hanoi(n,A,B,C:integer);
begin if n>0 then begin
Hanoi(n-1,A,C,B);
Form1.Memo1.Lines.Add(Format('d%をd%からd%へ移す',[n,A,C]));
Hanoi(n-1,B,A,C);

というような再帰手続きを使って、
単にAからCへｎ枚の塔を移す手順をMemoに
表示していくだけのプログラムを
作るならばもっと簡単にできるでしょうか？

A,B,Cの設定がよくわかりません…

ユコウ 2006-10-07 13:21:29 No: 23502

× Form1.Memo1.Lines.Add(Format('d%をd%からd%へ移す',[n,A,C]));
○ Form1.Memo1.Lines.Add(Format('%dを%dから%dへ移す',[n,A,C]));

訂正

とりみんぐ 2006-10-08 02:34:54 No: 23503

>単にAからCへｎ枚の塔を移す手順をMemoに
>表示していくだけのプログラムを

配列とImage表示部分をカットするだけで、n枚に対応できるよ。
nが17でも Memo表示が131,071行になるけど。

名前なし 2006-10-09 21:39:27 No: 23504

円盤 N枚の「ハノイの塔」対応版
30枚以上では画面からはみ出すかな。
64枚以上では計算不能(--;)…

procedure TForm1.Button1Click(Sender: TObject);
const
  SrcPole = 1;  // 最初の柱番号
  DstPole = 3;  // 目的の柱番号
  THICK = 14;   // 円盤の厚さ
  DIFD  = 15;   // 円盤の径差
  HPOS  = 10;   // 円盤の位置
var
  NumDisk: Integer;    // 円盤の枚数
  C: array of TColor;
  W: array of Integer;
  S: array of Integer;
  x: array of Integer;
  y: array of Integer;
  P: array[1..3]of Integer;
  H: array[1..3]of Integer;
  i: Integer;
  cnt, ans: Int64;
  ShowImage, HighSpeed: Boolean;
  procedure Carry(n, a, b: Integer);
  var
   t: Integer;
  begin
   Application.ProcessMessages;
   if Application.Terminated then exit;
   if n > 1 then Carry(n - 1, a, 6 - a - b);
   if ShowImage then begin
    if not CheckBox2.Checked then begin
     for t:=1 to 100 do begin
      Application.ProcessMessages; Sleep(10);
      if Application.Terminated then exit;
     end;
    end else begin
     Sleep(1);
    end;
   end else begin
    Sleep(0);
   end;
   inc(cnt);
   Memo1.Lines.Add(Format('%5d回目：円盤 %d を %d から %d に移す', [cnt, n, a, b]));
   TButton(Sender).Caption := Format('%d/%d',[cnt, ans]);
   if ShowImage then begin
    with Image1.Canvas do begin
     Pen.Color := clWhite;
     Brush.Color := clWhite;
     RectAngle(x[n]+S[n], y[n], x[n]+S[n]+W[n], y[n]+THICK);
     Pen.Color := clBlack;
     Brush.Color := C[n];
     x[n] := P[b];
     y[n] := H[b];
     H[a] := H[a]+THICK;
     H[b] := H[b]-THICK;
     RectAngle(x[n]+S[n], y[n], x[n]+S[n]+W[n], y[n]+THICK);
     TextOut(x[n]+S[n]-2+ W[n] div 2, y[n]+1, IntToStr(n));
    end;
   end;
   if n > 1 then Carry(n - 1, 6 - a - b, b);
  end;
begin
  ShowImage := CheckBox1.Checked;
  HighSpeed := CheckBox2.Checked;
  with SpinEdit1 do begin
   MinValue := 1;
   MaxValue := 64;
   if Value < 1 then Value := 1;
   NumDisk := Value;
  end;
  Memo1.Clear;
  ans := Trunc(IntPower(2, NumDisk) - 1);
  cnt := 0;
  if ShowImage then begin
   Randomize;
   SetLength(C, NumDisk+1); for i:=1 to High(C) do C[i] := Random($28) shl 18 + Random($28) shl 10 + Random($28) shl 2 + $606060;
   SetLength(W, NumDisk+1); for i:=1 to High(W) do W[i] := i*DIFD + 20;
   SetLength(S, NumDisk+1); for i:=1 to High(S) do S[i] := (High(S)*DIFD - i*DIFD) div 2;
   P[1] := 10; P[2] := NumDisk*DIFD+25 + 10; P[3] := (NumDisk*DIFD+25)*2 + 10;
   H[SrcPole] := HPOS;
   H[SrcPole mod 3 + 1] := HPOS + THICK * NumDisk;
   H[(SrcPole+1) mod 3 + 1] := HPOS + THICK * NumDisk;
   SetLength(x, NumDisk+1);
   SetLength(y, NumDisk+1);
   with Image1.Canvas do begin
    Font.Size := 9;
    SetBkMode(Image1.Canvas.Handle, TRANSPARENT);
    Brush.Color := clWhite;
    RectAngle(0, 0, Width, Height);
    for i:=1 to NumDisk do begin
     x[i] := P[SrcPole];
     y[i] := HPOS + THICK * i;
     Pen.Color := clBlack;
     Brush.Color := C[i];
     RectAngle(x[i]+S[i], y[i], x[i]+S[i]+W[i], y[i]+THICK);
     TextOut(x[i]+S[i]-2+ W[i] div 2, y[i]+1, IntToStr(i));
    end;
   end;
  end;
  TButton(Sender).Enabled := False;
  Carry(NumDisk, SrcPole, DstPole);
  TButton(Sender).Enabled := True;
end;

ミモフタモナイが 2006-10-10 18:12:41 No: 23505

ハノイの塔ｎの手数は2^n-1ですね。
最終手の一手前になるようにするためには(n-1)枚の場合のハノイ手順が必要、なので。
え？上記回答で示してある？スミマセン

再起版 2006-10-10 23:15:51 No: 23506

ここを参考。
http://www2.cc.niigata-u.ac.jp/~takeuchi/tbasic/BackGround/Hanoi.html

var
Form1: TForm1;
count: Int64;

implementation

{$R *.dfm}

procedure  Hanoi(n, A,B,C :Integer);
begin
   If n>0 then
   begin
      Hanoi(n-1, A,C,B);
      Form1.Memo1.Lines.Add(Format('%4d: %d番の円盤を %d から %d へ移動',[count,n-1, A,C]));
      Inc(count);
      Hanoi(n-1, C,B,A);
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

count :=1;
Hanoi( StrtoIntDef(Edit1.text,3) , 1 ,2, 3);

end;