\ Obtained by e-mail on June 6, 2002 \ from Mark I Manning IV, i440r @ lycos . com \ His refinement is a variation of Kolar's Algorithm No. 3 \ itower.f - isforth itterative towers of hanoi solution \ ------------------------------------------------------------------------ \ this code is heavilly based on the world famouns forth code by \ peter midnight to recursivly solve the towers of hanoi. this code \ however solves the problem using a very simple itterative method as \ described below. this code, peter midnights original version \ (slightly modified to compile under my forth compiler) and of corse \ my forth compiler can be found at http://isforth.clss.net \ ------------------------------------------------------------------------ \ method found at http://hanoitower.mkolar.org/algo.html \ Initial move: \ \ Disk 1 is moved to peg 3 if n is odd, and to peg 2 if n is even. \ \ Subsequent moves depend on the parity of the disk transferred in the \ immediately preceding move: \ \ If its parity is even, the destination peg in the next move will \ remain the same, and the next disk will be transferred there from the \ peg that was not involved in the immediately preceding move (this disk \ will be placed on top of the previously transferred even disk, and \ therefore must be odd) \ \ If its parity is odd, the next transfer will be between pegs that \ are both different from the immediately preceding destination peg, and \ the direction of the move is such that a smaller disk is placed on top \ of a larger one. \ ------------------------------------------------------------------------ \ given the above algorithm i came up with the following refinement \ with an odd numbr of disks \ \ odd disks always move left to right \ even disks always move right to left \ you always move the smallest disk of the two that were not moved in \ the previous move \ \ with and even number of disks \ \ odd disks always move right to left \ even disks always move left to right \ etc \ a left move from the first post and a right move from the last post both \ wrap arround to the other end \ ---------------------------------------------------------------------------- vocabulary hanoi hanoi definitions \ ------------------------------------------------------------------------ create t0 30 allot t0 30 erase create t1 30 allot t1 30 erase create t2 30 allot t2 30 erase 0 var n \ number off disks 0 var nmax \ max number of disks per tower create incrs -1 , 1 , \ odd/even disk directions create pegs t0 , t1 , t2 , \ array of towers \ ------------------------------------------------------------------------ \ after making a move the next disk to be moved will be from a tower \ other than the destination... create others 1 c, 2 c, \ tower numbers other than 0 0 c, 2 c, \ tower numbers other than 1 0 c, 1 c, \ towre numbers other than 2 \ ------------------------------------------------------------------------ \ this array gives us the tower numbers left or right from any tower \ left of tower 0 is 2, right of towre 2 is 0 create places 2 c, 0 c, 1 c, 2 c, 0 c, \ ------------------------------------------------------------------------ \ for a cheezy software delay :) 100000 var 2delay \ ------------------------------------------------------------------------ \ not defined in my kernel so... : beep 7 emit ; \ ------------------------------------------------------------------------ \ moved into a definition - makes it possible to turnkey : ?nmax cols 3 - 6 / !> nmax ; \ maximum rings for display size \ ------------------------------------------------------------------------ \ pause for clarity : delay ( centiseconds --- ) 10 * ms ; \ ------------------------------------------------------------------------ \ software delays are bad! dont use them! :) \ this is realy cheezy but it gives me the ability to make smaller \ lenght delays than 100 ms which is the true minimum sleep time in linux : delay2 2delay 0 ?do noop loop ; \ ------------------------------------------------------------------------ \ increase delay : delay++ 2delay 1000 + dup 200000 > if drop 200000 then !> 2delay ; \ ------------------------------------------------------------------------ \ decrease delay : delay-- 2delay 1000 - dup 0 < if drop 0 then !> 2delay ; \ ------------------------------------------------------------------------ : dokey key case: '=' opt delay-- \ speed up disk movement '-' opt delay++ \ slow down disk movement $20 opt quit \ quit (change to bye if doing a turnkey) ;case begin \ discard buffered keypresses key? while key drop repeat ; \ ------------------------------------------------------------------------ \ retained from midnight.seq - linux uses reversed order on x/y here : gotoxy swap at ; \ ------------------------------------------------------------------------ \ erase one tower of all disks : clear-tower ( tower --- ) n 1+ 2dup erase swap c! ; \ set depth to top disk on tower = blow base! \ ------------------------------------------------------------------------ \ erase all towers of all disks : clear-towers t0 clear-tower t1 clear-tower t2 clear-tower ; \ ------------------------------------------------------------------------ \ remove top disk from peg n1 : peg@ ( n1 --- n2 ) 4* pegs + @ \ point to source peg array dup c@ \ get index to top disk of peg n1 2dup 1+ swap c! \ move index down + c@ ; \ collect disk \ ------------------------------------------------------------------------ \ put disk n1 on peg n2 : peg! ( n1 n2 --- ) 4* pegs + @ \ point to destination peg array dup c@ \ get index to current top item of peg 1- 2dup swap c! \ point to next slot up + c! ; \ store disk in array \ ------------------------------------------------------------------------ \ get size of top disk of peg n1 without removing it : ?peg ( n1 --- n2 ) 4* pegs + @ \ point to peg to query dup c@ \ get indedx to top item of this tower dup n 1+ = \ tower empty? if nip \ yes - return n+1 == infinity ? else + c@ \ no get size of top disk then ; \ ------------------------------------------------------------------------ \ taken from p.m. code \ get column of specified tower position of post : pos ( tower --- col ) n 2* 1+ \ widest disk in twice n wide +1 * n + 1+ ; \ ------------------------------------------------------------------------ \ calculate y coordinate of disk : line ( tower --- line ) 4* pegs + @ \ point to tower array c@ 1+ ; \ get index to top item (move down 1 line too) \ ------------------------------------------------------------------------ \ display half a ring : halfdisplay ( color size --- ) for dup emit nxt drop ; \ ------------------------------------------------------------------------ \ display a whole ring : ( color size --- ) 2dup halfdisplay \ display left half of disk cuf \ skip central character (the post) halfdisplay ; \ display right edge of disk \ cuf is the terminfo name for 'cursor forward' \ ------------------------------------------------------------------------ \ display at proper position : display ( size col line color --- ) swap >r \ size col color -- store line on rstack -rot \ color size col over - r> \ color size x y gotoxy \ color size ; \ ------------------------------------------------------------------------ : raise ( size tower --- ) dup pos \ calculate x/y for disk swap line 2+ 2 swap do delay2 \ added to original - new machines = faster 2dup i bl display \ erase ring where it is 2dup i 1- '=' display \ show it one line higher -1 +loop 2drop ; \ ------------------------------------------------------------------------ : lower ( size tower --- ) dup pos swap line 2+ 2 do delay2 2dup i 1- bl display \ erase ring where it is 2dup i '=' display \ show it one line lower loop 2drop ; \ ------------------------------------------------------------------------ \ move ring to left : moveleft ( source destination --- ) pos swap pos 1- do delay2 dup i 1+ 1 bl display \ erase it where it is dup i 1 '=' display \ show it 1 column left -1 +loop drop ; \ ------------------------------------------------------------------------ \ move ring to right : moveright ( source destination --- ) pos 1+ swap pos 1+ do delay2 dup i 1- 1 bl display \ erase it where it is dup i 1 '=' display \ show it 1 column right loop drop ; \ ------------------------------------------------------------------------ \ move ring sideways \ modified from original code to use my ?: word : traverse ( size source destination --- ) 2dup > ?: moveleft moveright ; \ ------------------------------------------------------------------------ \ move disk from peg s to peg d : move ( s d --- ) over ?peg >r \ remember source disk size over r@ swap raise \ raise source disk 2dup r@ -rot traverse \ traverse disk to over destiation dup r> swap lower \ lower disk onto destination \ comment out the above 4 lines to see this go realyy fast :) swap peg@ \ now actually move the disk from tower to swap peg! ; \ tower \ ------------------------------------------------------------------------ \ draw tower on display : maketower ( tower --- ) pos 4 n + 3 do dup i gotoxy '|' emit loop drop ; \ ------------------------------------------------------------------------ \ draw base on display : makebase ( --- ) 0 n 4 + gotoxy n 6 * 3 + 0 do '-' emit loop ; \ ------------------------------------------------------------------------ \ this sets the direction of movement for odd/even disks based on how \ many disks there are. : set-incrs 1 -1 n 1 and ?: noop swap incrs ! incrs 4+ ! ; \ ------------------------------------------------------------------------ \ initialize display of puzzle : setup ( --- ) ed curoff set-incrs clear-towers 3 \ draw towers for r@ 1- maketower nxt makebase \ draw base 1 n do i 0 2dup lower peg! -1 +loop ; \ materialize rings \ ------------------------------------------------------------------------ \ when top position of tower 1 is filled we are solved : ?solved t1 1+ c@ 0> ; \ ------------------------------------------------------------------------ \ we always move smaler of 2 disks not moved in last go : ?next ( tower --- 'tower ) 2* others + \ get # of towers other than last destination dup c@ swap 1+ c@ 2dup \ find which tower has smallest disk at top ?peg swap ?peg < ?: \ and return that towers number nip \ this will be our next source drop ; \ ------------------------------------------------------------------------ \ itterativly solve the towers of hanoi puzle : solve ( tower --- ) begin dup \ remember source tower ?peg 1 and \ is dist at top of source tower odd or even 4* incrs + @ \ get movement direction based on parity over + 1+ places + c@ \ get index to destination tower tuck move \ move disk ?solved not \ if were not solved already while key? if dokey then \ handle any keypress and ?next \ get index to next source tower repeat drop ; \ solved - discard junk \ ------------------------------------------------------------------------ \ entry point - slightly modified from original : towers ( quantity --- ) ?nmax begin nmax over < if drop 3 then 3 max nmax min !> n ed setup n 2 0 1 over pos n 4 + gotoxy \ put cursor under rings beep 50 delay 0 solve beep 100 delay n 1+ again ; \ repeat indefinitely \ ========================================================================