ticoracer
06 de Marzo del 2006

Hola gente que tal?

amigos necesito su ayuda, estoy estudiando programacion y tengo que presentar un proyecto de Las Torres de Hanoi usando Pascal.

El proyecto debe seguir las sigtes reglas:

1-Mover los discos al 3er palo
2-Mover los discos de uno en uno
3-Mover los discos de un palo en uno (sin saltar ninguno)
4-Ningun disco grande estará encima de uno pequeño.

La verdad no tengo ni idea de como empezar

Alguien puede ayudarme?

Noel Solw
06 de Marzo del 2006

tengo hanoi en c++.
esto puede ayudarte ?

Noel Solw
06 de Marzo del 2006

Encontre, por casualidad, Hanoi en pascal.
Hace mucho tiempo que no programo en pascal y no tengo el compilador instalado, asi que no pude probarlo, pero creo que funciona bien.
Exito ! ! !

Noel Solw
06 de Marzo del 2006

program HanoiTowersA; {------------------------------------------------}
{ ‰…„ ‰Œƒ‚Ž š‰‰’ Œ™ ‰‰‘˜…—˜ …˜š”Œ š‰‹š }
{ .‰™…˜ƒ„ ‰‹Œ„Ž„ š€ š‰Œ…ŒŒ‰Ž „‚‰–Ž š‰‹š„ }
{ source a : ˜…—Ž„ ƒ…Ž’ }
{ auxiliar b : ˜†’ ƒ…Ž’ }
{ target c : ƒ’‰„ ƒ…Ž’ }
{ 1997 ‰…‰ 16 ,…Œ—™€ - vii Œ—‘” …˜…ˆ š‹ }
{------------------------------------------------}
uses fdelay,crt;

const
MAX = 12; { ‰˜‰Ž š…’ˆ ˜”‘Ž }
EMPTY = 0; { —‰˜ …—Ž …Ž‰‘ }
color : array[1..MAX] of byte = (LIGHTCYAN, LIGHTRED, LIGHTBLUE,
LIGHTGREEN, LIGHTMAGENTA,
CYAN, RED, BLUE, GREEN, MAGENTA,
LIGHTCYAN, LIGHTRED);
var
n : byte; { „˜’„Œ š…’ˆ„ ˜”‘Ž }
num : integer; { .... ˜”‘Ž ŠŒ„Ž }
a : array['a'..'c', 1..MAX] of byte; { ‰ƒ…Ž’Œ –Ž ‰‹˜’Ž }
p : array['a'..'c'] of byte; { ‰ƒ…Ž’ š…Ž…—Ž ‰’‰–Ž }


procedure InitArrays; {-------------------------}
{ Œ™ ‰–Ž Š˜’Ž Œ…‡š„ }
var { .‰’‰–Ž„… ‰ƒ…Ž’„ }
i : char; { š…ƒ…Ž’ } {-------------------------}
j : byte; { š…˜…™ }

begin (* INIT ARRAYS *)
num := 1; { ŠŒ„Ž ˜”‘Ž Œ…‡š„ }
for j := 1 to n do
begin
a['a',j] := n-j+1; { ˜…—Ž„ ƒ…Ž’ Œ…‡š„ }
a['b',j] := EMPTY; { ˜†’„ ƒ…Ž’ Œ…‡š„ }
a['c',j] := EMPTY; { ƒ’‰„ ƒ…Ž’ Œ…‡š„ }
end;
p['a'] := n; { ˜…—Ž„ ƒ…Ž’Œ ’‰–Ž Œ…‡š„ }
p['b'] := 0; { ˜†’„ ƒ…Ž’Œ ’‰–Ž Œ…‡š„ }
p['c'] := 0; { ƒ’‰„ ƒ…Ž’Œ ’‰–Ž Œ…‡š„ }
end; (* INIT ARRAYS *)


procedure Show; {-------------------------}
{ Œ™ Œ‹ ‰ƒ…Ž’„ š‚–„ }
var { .„˜’„ Œ™ Œ™… }
i : char; { š…ƒ…Ž’ } {-------------------------}
j : byte; { š…˜…™ }

begin (* SHOW *)
for i := 'a' to 'c' do
for j := 1 to n do
begin
GotoXY((ord(i)-ord('a'))*15+22, 18-j);
if a[i,j] = EMPTY then
Write(' .')
else
Write(a[i,j]:2);
end (* END LOOPS *)
end; (* SHOW *)


procedure InitShow; {-------------------------}
{ —Œ‡„ š‚–„Œ „˜…ƒ–…˜” }
begin (* INIT SHOW *) { .Š‘Ž„ Œ™ ’…—„ }
ClrScr; {-------------------------}
GotoXY(9,1);
Write('Hanoi Towers: ');
GotoXY(22,20);
Write('[a] [b] [c]');
end; (* INIT SHOW *)


function GetNum : byte; {-------------------------}
{ ˜”‘Ž šˆ‰Œ—Œ „‰–—…” }
var {.Š‰Œ„š š…”šš™Ž„ š…’ˆ„ }
n : byte; {-------------------------}

begin (* GET NUM *)
GotoXY(9,3);
Write('number of disks = ');
Readln(n);
GetNum := n;
end; (* GET NUM *)


procedure Move(n : byte; source, target : char); {-------------------------}
{ š…˜’„„ š‚–„Œ „˜…ƒ–…˜” }
begin (* MOVE *) {-------------------------}
GotoXY(5,24);
Write(num:5,' : move disk ', n, ' from ', source, ' to ', target, ' ');
inc(num);
ReadKey;
inc(p[target]);
a[target,p[target]] := a[source,p[source]];
a[source,p[source]] := EMPTY;
dec(p[source]);
Show;
end; (* MOVE *)
{-------------------------}
{ š‰‰‘˜…—˜ „˜…ƒ–…˜” }
{ ‰…„ ‰Œƒ‚Ž š‰‰’ …˜š”Œ }
{-------------------------}
procedure Towers(n : byte; { ˜”‘Ž š’ˆ }
source,auxiliar,target : char); { ‰ƒ…Ž’ Œ™ š…™ }

begin (* TOWERS *)
if n = 1 then
Move(n,source,target) { n …—Ž š’ˆ š˜’„ - „‰‘˜…—˜„Ž „€‰–‰ }
else
begin
Towers(n-1,source,target,auxiliar); { n-1 š‰‰‘˜…—˜ „€‡˜— }
Move(n,source,target); { n …—Ž š’ˆ š˜’„ }
Towers(n-1,auxiliar,source,target); { n-1 š‰‰‘˜…—˜ „€‡˜— }
end
end; (* TOWERS *)


begin (* MAIN *)
InitShow; { ’…— Š‘Ž —Œ‡ š‚–„ }
repeat
n := GetNum { „˜’„Œ š…’ˆ„ ˜”‘Ž šˆ‰Œ— }
until n <= MAX;
InitArrays; { ‰š™Ž Œ…‡š„ }
Show; { ‰šŒ‡š„ –Ž š‚–„ }
Towers(n,'a','b','c'); { „‰‘˜…—˜Œ „…™€˜„ „€‰˜—„ }
ReadKey;
end. (* MAIN *)

Noel Solw
06 de Marzo del 2006

program HanoiX; {------------------------------------------------}
{ .‰…„ ‰Œƒ‚Ž š‰‰’ Œ™ ‰‰‘˜…—˜ …˜š”Œ š‰‹š }
{ source a : ˜…—Ž„ ƒ…Ž’ }
{ auxiliar b : ˜†’ ƒ…Ž’ }
{ target c : ƒ’‰„ ƒ…Ž’ }
{ 1999 ‰…‰ 20 ,…Œ—™€ - vii Œ—‘” …˜…ˆ š‹ }
{------------------------------------------------}
uses fdelay,crt,Graph;

const
MAX = 12; { ‰˜‰Ž š…’ˆ ˜”‘Ž }
a = 1; { a ƒ…Ž’ ‰‰–Ž }
b = 2; { b ƒ…Ž’ ‰‰–Ž }
c = 3; { c ƒ…Ž’ ‰‰–Ž }
d = 9; { š’ˆ ‡…˜ š’‰—Œ ’…— }
e = 3; { š…’ˆ ‰ ‰‡……˜Ž š’‰— }
h = 30; { š’ˆ „…‚ š’‰—Œ ’…— }
dd = 5; { š…††„ ‰Œ‘—” ˜”‘Ž …ƒ‰— }
yo = 650; { ‰ƒ…Ž’„ ‘‰‘ …—‰Ž }
top = 180; { š…’ˆ š††„Œ ‰ŒŽ‰‘—Ž „…‚ }
BkColor = 140; { ’—˜„ ’– }
TextCol = 52; { „‰š‹ ’– }
ESCAPE = #27;

type
columns = a..c;
rows = 1..MAX;
Vector = array [rows] of byte;
Towers = record { ‰ƒ…Ž’„ 3 Œ‹Œ ‰…š ‚…‘ }
disk : Vector; { š…’ˆ Š˜’Ž }
p : byte; { Œ…”‰ˆ š’ˆŒ ˜ˆ‰…” }
x : integer; { ‰—”…€ - ƒ…Ž’„ …—‰Ž }
end;

var
n : byte; { „˜’„Œ š…’ˆ„ ˜”‘Ž }
times : byte; { š…ƒƒ… š…††„ š‰‰’™„ Ž† }
num : integer; { num ˜”‘Ž ŠŒ„Ž }
t : array[columns] of Towers; { ‰ƒ…Ž’Œ –Ž ‰‹˜’Ž }
MaxX,MaxY : integer; { ‰”˜‚ Š‘Ž Œƒ…‚ }
color : Vector; { š…’ˆ„ ‰’– š—†‡„Œ Š˜’Ž }


procedure GraphInit; {---------------------------------}
{ 1024 x 768 :‰”˜‚ Š‘Ž Œ…‡š„ }
var { .‰’– 256 }
driver,mode,code : integer; {---------------------------------}
path : string[30];

begin (*GRAPH INIT*)
driver := InstallUserDriver('vesa',nil);
mode := 4;
path := 'd:bpbgi';
InitGraph(driver,mode,path);
code := GraphResult;
while code <> grOK do
begin { š€‰–ŽŒ ƒ’ š˜†…‡ „Œ…’” }
WriteLn('path defined as: ',path); { „Ž‰€šŽ„ bgi-„ š‰‰˜”‘ }
Write('enter new path name: ');
ReadLn(path);
driver := InstallUserDriver('vesa',nil);
mode := 4;
InitGraph(driver,mode,path);
code := GraphResult;
end;
MaxX := GetMaxX;
MaxY := GetMaxY;
t[b].x := Round(MaxX/(2*dd))*dd;
t[a].x := Round(MaxX/(5*dd))*dd;
t[c].x := Round((MaxX-t[a].x)/dd)*dd;
end; (*GRAPH INIT*)

procedure EndOfJob(fin : boolean); {---------------------------------}
{ š‰‹š„ …‰‘Œ š…Œ…’” }
begin (* END OF JOB *) {---------------------------------}
SetTextStyle(10,0,5);
SetColor(TextCol);
if fin then
OutTextXY(30,100,'end of game - good bye ! ! !')
else
OutTextXY(30,100,'user interruption - good bye !');
ReadKey;
CloseGraph
end; (* END OF JOB *)

function GetNum : byte; {---------------------------------}
{ Œ™ ˜”‘Ž šˆ‰Œ—Œ „‰–—…” }
var {---------------------------------}
n : byte;
a : char;
x : integer;

begin (* GET NUM *)
SetFillStyle(1,BkColor);
SetColor(TextCol);
x := 600;
OutTextXY(x,10,'number of disks : ');
repeat
n := 0;
x := 600 + TextWidth('number of disks : ');
bar(x,20,MaxX,60);
a := ReadKey;
While a <> #13 do
begin
OutTextXY(x,10,a);
x := x + TextWidth(a);
n := n*10 + ord(a) - ord('0');
a := ReadKey;
end; (* WHILE a <> enter *)
until n in [1..12];
GetNum := n;
end; (* GET NUM *)

procedure ShowNumber; {---------------------------------}
{ ‰˜…ƒ‰‘ ŠŒ„Ž ˜”‘Ž š‚–„ }
const {---------------------------------}
x = 400;

var
s : string;

begin (* SHOW NUMBER *)
inc(num);
str(num,s);
SetFillStyle(1,130);
Bar(x-30,20,x+TextWidth(s)+30,70);
SetColor(White);
OutTextXY(x,15,s);
SetColor(Black);
end; (* SHOW NUMBER *)


procedure Initialize; {---------------------------------}
{ ‰š™Ž„ Œ™ ‰‰šŒ‡š„ ‰‹˜’ }
var {---------------------------------}
i : columns; { š…ƒ…Ž’ }
j : rows; { š…˜…™ }

begin (* INITIALIZE *)
num := -1; { ŠŒ„Ž ˜”‘Ž Œ…‡š„ }
times := 5;
with t[a] do { ˜…—Ž„ ƒ…Ž’ Œ…‡š„ }
begin
p := n;
for j := 1 to n do
disk[j] := n-j+1;
end;
for i := b to c do { ˜†’„ ƒ…Ž’ Œ…‡š„ }
with t[i] do
p := 0;
for j := 1 to MAX do
color[j] := j + 40;
end; (* INITIALIZE *)

procedure GetUserChoice; {---------------------------------}
{ .Œ‰’”Ž„ š…€˜…„ šˆ‰Œ— }
var {---------------------------------}
choice : char;

begin (* GET USER CHOICE *)
if KeyPressed then
begin
choice := ReadKey;
case choice of
ESCAPE : begin
EndOfJob(FALSE);
halt(0);
end;
'-' : if times < 254 then
inc(times);
'+' : if times > 0 then
dec(times);
end (* CASE *)
end (* IF KEYPRESSED *)
end; (* GET USER CHOICE *)

procedure ShowDisk(x,y : integer; disk : byte; show : boolean);

begin (* SHOW DISK *) {---------------------------------}
GetUserChoice; { .šƒƒ… š’ˆ Œ™ „—‰‡Ž …€ „‚–„ }
if show then {---------------------------------}
begin
SetColor(Black);
SetFillStyle(1,color[disk])
end
else
begin
SetColor(BkColor);
SetFillStyle(1,BkColor);
end; (* IF SHOW *)
bar(x-(disk+2)*d,y-e,x-d-e,y-h+e);
bar(x+(disk+2)*d,y-e,x+d+e,y-h+e);
rectangle(x-(disk+2)*d,y-e,x-d-e,y-h+e);
rectangle(x+(disk+2)*d,y-e,x+d+e,y-h+e);
if show then
delay(times);
end; (* SHOW DISK *)


procedure FirstShow; {---------------------------------}
{ .‰šŒ‡š„ ‰ƒ…Ž’ –Ž š‚–„ }
var {---------------------------------}
j : rows; { š…˜…™ }
y : integer; { a „ƒ…Ž’ }

begin (* FIRST SHOUW *)
y := yo;
SetColor(Black);
with t[a] do
begin
for j := 1 to n do
begin
ShowDisk(x,y,disk[j],TRUE);
y := y - h;
end
end;
delay(500);
end; (* FIRST SHOW *)

procedure InitScreen; {---------------------------------}
{ .Š‘Ž„ Œ™ ’…—„ —Œ‡„ „‚–„ }
var {---------------------------------}
i : columns;
y : integer;
s : string[3];

begin (* INIT SCREEN *)
SetFillStyle(1,BkColor);
bar(0,0,MaxX,MaxX);
SetLineStyle(0,0,3);
SetTextStyle(10,0,3);
SetColor(TextCol);
GotoXY(9,1);
OutTextXY(30,10,'Hanoi Towers');
y := yo + e;
SetColor(Black);
for i := a to c do
with t[i] do
begin
SetFillStyle(1,53);
bar(x-d,y,x+d,y-Max*h-h);
SetFillStyle(1,54);
bar(x-15*d,y,x+15*d,y+2*d);
rectangle(x-d,y,x+d,y-Max*h-h);
rectangle(x-15*d,y,x+15*d,y+2*d);
SetColor(TextCol);
s := '(' + char(ord('a')+i-1) + ')';
OutTextXY(x-TextWidth(s) div 2,yo + 35,s);
SetColor(Black);
end; (* FOR I *)
SetFillStyle(1,32);
bar(30,y+2*d,MaxX-30,y+4*d);
rectangle(30,y+2*d,MaxX-30,y+4*d);
end; (* INIT SCREEN *)

procedure MoveUp(xx,yy,disk : integer);

begin {---------------------------------}
while yy > top do { „Œ’Ž š’ˆ š††„ }
begin {---------------------------------}
ShowDisk(xx,yy,disk,FALSE);
dec(yy,dd);
ShowDisk(xx,yy,disk,TRUE);
end
end;

procedure MoveRight(xx,limit,disk : integer);

begin {---------------------------------}
while xx < limit do { „‰Ž‰ š’ˆ š††„ }
begin {---------------------------------}
ShowDisk(xx,top,disk,FALSE);
inc(xx,dd);
ShowDisk(xx,top,disk,TRUE);
end
end;

procedure MoveLeft(xx,limit,disk : integer);

begin {---------------------------------}
while xx > limit do { „Œ€Ž™ š’ˆ š††„ }
begin {---------------------------------}
ShowDisk(xx,top,disk,FALSE);
dec(xx,dd);
ShowDisk(xx,top,disk,TRUE);
end
end;

procedure MoveDown(xx,bottom,disk : integer);

var {---------------------------------}
yy : integer; { „ˆŽ š’ˆ š††„ }
{---------------------------------}
begin
yy := top;
while yy < bottom do
begin
ShowDisk(xx,yy,disk,FALSE);
inc(yy,dd);
ShowDisk(xx,yy,disk,TRUE);
end
end;


procedure Move(n : byte; source, target : columns);

{---------------------------------}
begin (* MOVE *) { š…’ˆ š††„ }
ShowNumber; {---------------------------------}
inc(t[target].p);
with t[source] do
begin
MoveUp(x,yo-p*h+h,disk[p]);
if t[target].x > x then
MoveRight(x,t[target].x,disk[p])
else
MoveLeft(x,t[target].x,disk[p]);
MoveDown(t[target].x,yo-t[target].p*h+h,disk[p]);
end;
t[target].disk[t[target].p] := t[source].disk[t[source].p];
dec(t[source].p);
end; (* MOVE *)
{---------------------------------}
{ Š‰Œ„š„ Œ - ‰‰‘˜…—˜ „˜…ƒ–…˜” }
{---------------------------------}
procedure HanoiTowers(n : byte; { ˜”‘Ž š’ˆ }
source,auxiliar,target : columns);{ ‰ƒ…Ž’ Œ™ š…Ž™ }

begin (* HANOI TOWERS *)
if n = 1 then
Move(n,source,target) { n …—Ž š’ˆ š˜’„ - „‰‘˜…—˜„Ž „€‰–‰ }
else
begin { n-1 š‰‰‘˜…—˜ „€‡˜— }
HanoiTowers(n-1,source,target,auxiliar);
Move(n,source,target); { n …—Ž š’ˆ š˜’„ }
HanoiTowers(n-1,auxiliar,source,target);
end { n-1 š‰‰‘˜…—˜ „€‡˜— }
end; (* HANOI TOWERS *)


begin (* MAIN *)
GraphInit;
InitScreen; { ’…— Š‘Ž —Œ‡ š‚–„ }
n := GetNum; { „˜’„Œ š…’ˆ„ ˜”‘Ž šˆ‰Œ— }
Initialize; { ‰š™Ž Œ…‡š„ }
ShowNumber; { „…™€˜ „‚–„-‰˜…ƒ‰‘ ˜”‘Ž }
FirstShow; { ‰šŒ‡š„ –Ž š‚–„ }
HanoiTowers(n,a,b,c); { „‰‘˜…—˜Œ „…™€˜„ „€‰˜—„ }
EndOfJob(TRUE)
end. (* MAIN *)

{--------------------------- end of list --------------------------------}

Noel Solw
06 de Marzo del 2006

program HanoiTowers; (* solucion recursiva *)

uses fdelay,crt;

var
n : byte;
num : integer;

procedure Move(n : byte; source, target : char);

begin (* MOVE *)
WriteLn(num:5,' : move disk ', n, ' from ', source, ' to ', target);
inc(num);
end; (* MOVE *)

procedure Towers(n : byte; source,auxiliar,target : char);

begin (* TOWERS *)
if n = 1 then
Move(n,source,target)
else
begin
Towers(n-1,source,target,auxiliar);
Move(n,source,target);
Towers(n-1,auxiliar,source,target);
end
end; (* TOWERS *)


begin (* MAIN *)
ClrScr;
num := 1;
Write('number of disks = ');
Readln(n);
WriteLn;
Towers(n,'a','b','c');
ReadLn;
end. (* MAIN *)