Regarding Style
It would probably be more idiomatic to use a named let
form in place of the internal define
form for move-tower
. This might complicate future memoization if you choose to use a ready-made library procedure to memoize the recursive process, but that won't be a problem for us.
Regarding the Basic Design
The idea to use free-peg
is clever, but I think that it obfuscates the overall procedure a bit; this can be made significantly simpler and clearer, in my opinion, by using three parameters for the peg designators. These designators can then be used directly in the recursive calls to show more clearly what is happening.
With this change, there is no need for any internal definitions. To simplify the procedure calls you can make these peg designator parameters optional, providing default values. This also allows the caller to specify particular designators as desired, e.g., a caller may prefer to use 'a
, 'b
, and 'c
.
Here is such a procedure with defaults that match the OP scheme:
(define (hanoi-list-slow n (start 1) (dest 3) (temp 2))
(if (zero? n)
'()
(append (hanoi-list-slow (- n 1) start temp dest)
(list (list start dest))
(hanoi-list-slow (- n 1) temp dest start))))
Regarding Performance
Both the OP procedure hanoi
and the above procedure hanoi-list-slow
do a lot of work that duplicates previous work. The easiest way to see this may be to write out an expansion of the recursive algorithm into single moves.
;;; To move:
;;; 4 disks from 1 to 3
;;;
;;; We must calculate:
;;; 3 from 1 to 2
;;; 2 from 1 to 3 (duplicated below)
;;; 1 from 1 to 2
;;; 1 from 1 to 3
;;; 1 from 2 to 3
;;; 1 from 1 to 2
;;; 2 from 3 to 1
;;; 1 from 3 to 2
;;; 1 from 3 to 1
;;; 1 from 2 to 1
;;; 1 from 1 to 3
;;; 3 from 2 to 3
;;; 2 from 2 to 1
;;; 1 from 2 to 3
;;; 1 from 2 to 1
;;; 1 from 3 to 1
;;; 1 from 2 to 3
;;; 2 from 1 to 3 (duplicate moves)
;;; 1 from 1 to 2
;;; 1 from 1 to 3
;;; 1 from 2 to 3
Here you can see that the sequence of single moves required to move 2 disks from peg 1 to peg 3 is calculated twice by the recursive algorithm. The amount of duplication will grow very quickly as the number of disks grows. A classic solution to this problem is to save the results of recursive procedure calls so that later calls can look these results up before making a new, potentially expensive, recursive call. This technique is called memoization.
Another answer here has pointed this out and suggested a Racket package (memoize, documentation here) that provides a convenient way to memoize procedures, but this is not difficult to do so let's just rewrite hanoi-list-slow
so that it is memoized.
This may look complicated, but there isn't that much to understand, and it is good to be able to memoize your own procedures when necessary:
(define (hanoi-list-memo n (start 1) (dest 3) (temp 2))
(let ((memo '()))
(let move-disks ((n n) (start start) (dest dest) (temp temp))
(if (zero? n)
'()
(let* ((memo-tag (list n start dest temp))
(memo-entry (assoc memo-tag memo)))
(if memo-entry
(cdr memo-entry) ; return result if already memoized
; otherwise calculate a new result
(let* ((moves-so-far (append (move-disks (- n 1) start temp dest)
(list (list start dest))
(move-disks (- n 1) temp dest start)))
(new-memo (cons memo-tag moves-so-far)))
; memoize the new result
(set! memo (cons new-memo memo))
; return the new result
moves-so-far)))))))
The above procedure uses a named let
form. This could as easily be written to use an internal define
to create a local move-disks
procedure, but this style is both more idiomatic in Racket (and in Scheme) and more clear in my opinion.
The fundamental change is that hanoi-list-memo
itself is no longer a recursive procedure, but it wraps a let
form which keeps a list of results as memo
, and this let
form then wraps the recursive procedure defined in a named let
form. This internal move-disks
procedure works as before, except that it looks in memo
to see if it has been called previously with the current arguments; if so it doesn't need to calculate the result for the current call, but it can just return the previously saved result. Otherwise it does calculate the result and saves it for future calls.
The memo
list itself is an association list that is filled with pairs which contain a tag in the car
position that identifies the arguments associated with a result; the result is stored in the cdr
position of each pair. Association lists are time-honored lisp data structures composed of key-value pairs that are perfect for this sort of thing, and Racket provides the assoc
procedure to facilitate searching an association list by key.
When n
is zero move-disks
returns an empty list of moves, as before. Otherwise move-disks
searches for a key (memo-tag
) constructed from the current arguments. If this key is found move-disks
just returns the saved result. Otherwise it calculates the result in the same way as the original hanoi-list-slow
procedure, then creates a new entry for the memo
list, and finally adds that entry to the memo
list before returning the new result.
Lets look at a few timings. Here is a simple procedure to test the contestants:
(define (test-hanoi hanoi-fn n (tests-left 10)
(heater 2) (tests-done 0)
(moves 0) (sum-real 0))
(collect-garbage)
(if (zero? tests-left)
(printf "Average real time over ~A tests for ~A disks, ~A moves: ~A ms~%~%"
tests-done n moves (exact->inexact (/ sum-real tests-done)))
(let-values (((hanoi-length cpu-ms real-ms gc-ms)
(time-apply hanoi-fn (list n))))
(if (zero? heater)
(test-hanoi hanoi-fn n (- tests-left 1)
0 (+ tests-done 1)
(length (first hanoi-length))
(+ sum-real real-ms))
(test-hanoi hanoi-fn n tests-left (- heater 1) 0 0 0)))))
And here are some timings:
hanoi.rkt> (test-hanoi hanoi-op 20 50)
Average real time over 50 tests for 20 disks, 1048575 moves: 309.9 ms
hanoi.rkt> (test-hanoi hanoi-list-slow 20 50)
Average real time over 50 tests for 20 disks, 1048575 moves: 285.12 ms
hanoi.rkt> (test-hanoi hanoi-list-memo 20 50)
Average real time over 50 tests for 20 disks, 1048575 moves: 68.56 ms
hanoi.rkt> (test-hanoi hanoi-memoize 20 50)
Average real time over 50 tests for 20 disks, 1048575 moves: 89.82 ms
The first test is the of original OP definition; it compares with the test of hanoi-list-slow
defined above in this answer. Repeated tests seem to show these two as about the same in terms of timings.
The third test is of the memoized hanoi-list-memo
procedure defined above in this answer; it compares with the memoized procedure defined in another answer here (and named hanoi-memoize
in my testing code). Repeated tests seem to show hanoi-list-memo
consistently beating hanoi-memoize
in timings. I'm not sure why this is, but I suspect that it has to do with the implementation of memoization in the memoize
package. I haven't looked at the implementation; if it uses hash tables instead of association lists it may be at a disadvantage when a relatively small number of calls need to be memoized.
In any case, this provides a reason to be able to implement memoization for yourself; sometimes a simple implementation will outperform a more general implementation found in a library. This of course holds for most any library procedure.
Regarding Memory
OP has said: "I run out of memory when I give it a large number of disks."
This is not a problem that could be solved by writing tail recursions. The fundamental problem is that the OP procedure is generating a list of single moves required to move a stack of disks from one peg to another. This list must be stored in memory, and its size is not related to the size of the call stack. As we know, this number grows very fast. In fact, for n disks, 2ⁿ-1 single moves are required. For n = 25 the result list contains 33,554,431 entries (single moves); assuming that each entry pair is comprised of two 64 bit pointers that is about 512MB of memory. Increasing n by one will double this requirement. I am not sure how much dynamic heap memory Racket makes available, but this is probably around that limit. There may be a way to increase the amount of available memory in Racket (I am unaware of it) but as we noted, this could only allow a small increase in the magnitude of n.
If the OP wants to return a list of moves, I am afraid that they are pretty much stuck with the memory limitations of their system (assuming that it is possible to grow the Racket dynamic heap size). But, if OP would settle for simply recording a list of moves, it would be possible to write that list to a file instead of to memory. That might start with something like this:
(define (hanoi-list-fprint out n (start 1) (dest 3) (temp 2))
(if (zero? n)
(fprintf out "")
(begin (hanoi-list-fprint out (- n 1) start temp dest)
(fprintf out "(~A ~A)~%" start dest)
(hanoi-list-fprint out (- n 1) temp dest start))))