ハノイの塔の解を教えてください (ID:23500)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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

以下、「解」じゃないけど、見てると面白い？
解を求めるには 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;

←解決時は質問者本人がここをチェックしてください。

戻る