-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathhanoi
executable file
·107 lines (99 loc) · 4.76 KB
/
hanoi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
#!ff needs
\ $Id: hanoi,v 1.2 2006-12-15 11:21:51 lavarenn Exp $
\ Hanoi Tours (with four conditionally compilable display variations)
'$' parse ( -- @ # ) dup>r here rot over r> ( -- # h @ h # ) dup allot ;
"Hanoi Tours" is a classical mathematical problem presented as a game,
that you can play on a table corner with a few coins of different sizes.
Stack them up by decreasing sizes, with the smallest one on top of stack.
Given two other stack locations, initially empty, move one coin at a time
from the top of one stack to the top of another stack, but never put a coin
on top of a smaller one. Move coins until you've moved the complete stack.
The minimum number of moves is computed recursively: for N coins you need
to move the N-1 top coins to a second stack location, then move the biggest
one to the third stack location, then move the N-1 other ones on top of it,
i.e. twice the number of moves for a stack of N-1 coins plus one move, this
gives 2^N-1 moves for N coins. This implementation is non-recursive :-)
$ cmove : .intro` lit lit type ; \ --
\ 0
\ 1 -|- | |
\ 2 --|-- | |
\ 3 ---|--- | |
\ 4 ----|---- | |
\ 5 -----|----- | |
\ 6 ------|------ | |
\ 7 -------|------- | |
\ 8 --------|-------- | |
\ 9 a b c
[0] [IF] \ simplest variant ==========================================
variable #m \ number of moves
variable #d \ number of disks
create ds 8 allot \ disk stack
[1] [IF] \ simplest display with numbers --------------------
: ._ cls` ."Hanoi_Tours" 3 TIMES #d@ 2 r - cr 'a' over+ emit .":" over TIMES
r ds+ c@ = drop IF r '1'+ emit swap 1- swap THEN
REPEAT 2drop REPEAT
[ELSE] \ "graphical" display with horizontal lines ----------
create dd 24 allot ; dd 24 32 fill dd 8+ 8 '-' fill
: .- dd 2dup+ 8 type ."|" swap - 16+ 8 type ; \ w --
: ._ cls` 3 TIMES #d@ r over TIMES
r ds+ c@ = drop IF 2dup 17* swap atxy r 1+ .- swap 1- swap THEN
REPEAT 17* swap TIMES dup r 1+ atxy 0 .- REPEAT drop REPEAT
0 #d@ 1+ atxy 'a' 3 TIMES dd 8 type dup emit 1+ dd 8 type REPEAT drop
[THEN] \ ----------------------------------------------------
cr #m@ .
."(a:b<->c__b:c<->a__c:a<->b__i(n--):init__s(n--):solution__h:help)^J" ;
: top ds #d@ TIMES tuck c@ <> drop swap 0<> WHILE 1+ REPEAT nip ; \ s -- @
: i` ;` 1- 7& 1+ dup #d! ds swap erase 0 #m! \ n -- ; init
: a` 1 2 SKIP
: b` 2 0 SKIP
: c` 0 1 THEN THEN over top over top = IF 2drop 2drop ._ ;THEN
u< IF drop c! drop ELSE nip nip c! THEN 1 #m +! ._ ;
: d 333 ms ;
: s` \ -- ; solution
;` i` 500 ms
1 #d@ << BEGIN 1- 0<> WHILE d b` 1- 0<> WHILE d c` 1- 0<> WHILE d a` REPEAT drop ;
[ELSE] \ variant with animations =======================================
variable #m \ number of moves
create st 30 allot \ 3 stacks
: >st 10* st+ ; \ s -- @
[0] [IF] \ simplest display with numbers ------------------
: ._ \ --
50 ms cls` ."Hanoi_Tours"
st 3 TIMES cr dup 9 type 10+ .":" 'c' r - emit REPEAT drop
[ELSE] \ "graphical" display with horizontal lines --------
: dd "________--------________" drop ;
: .- \ w c dd
swap dd 2dup+ 8 type swap - swap emit 16+ 8 type ;
: ._ \ --
50 ms cls` 3 TIMES r >st r 17*
9 TIMES 2dup r atxy r + c@ $F& r 0- 0<> 32_ IF '|'_ THEN .- REPEAT
2drop REPEAT 0 9 atxy 0 'a' 2dup .- 1+ 2dup .- 1+ .-
[THEN] \ --------------------------------------------------
cr #m@ .
."(a:b<->c__b:c<->a__c:a<->b__i(n--):init__s(n--):solution__h:help)^J" ;
: top \ @ -- @'
BEGIN c@+ $F& 0<> drop UNTIL 1- ;
: up \ @ -- n
dup>r top dupc@ 32$00+ swap BEGIN 1- 2dupw! ._ r = drop UNTIL
32 swap c! rdrop ;
: dn \ n @ --
2dupc! swap 8 << 32+ swap \ -- n<<8+32 @
BEGIN ._ dupw@ $F00& drop 0= WHILE 2dupw! 1+ REPEAT 2drop ;
: a` 1 2 0 SKIP
: b` 2 0 1 SKIP
: c` 0 1 2 THEN THEN
>st dup top 1- = 2drop IF 2drop ;THEN >st swap >st 1 #m +!
over top c@ over top c@ < 2drop IF swap THEN up swap dn ;
: i` \ n -- ; init
;` 1- 7& 1+ 0 #m! st 30 32 fill '9' st 9+ 2dupc! 10+ 2dupc! 10+ c!
0 >st swap TIMES r '1'+ over dn REPEAT drop ;
: s` \ n -- ; solution
;` 1- 7& 1+ dup i` 500 ms
1 swap << BEGIN 1- 0<> WHILE b` 1- 0<> WHILE c` 1- 0<> WHILE a` REPEAT drop ;
[THEN] \ ================================================================
'$' parse ( -- @ # ) dup>r here rot over r> ( -- # h @ h # ) dup allot ;
Use: to move one coin between two stacks, enter the name of the third stack;
to initialize a new stack of 4 coins (max 8) enter: 4 i
to show the solution for a stack of 5 coins, enter: 5 s
$ cmove ; : h` ._ lit lit type ;
3 s .intro EOF enjoy!