3
\$\begingroup\$

I'm in the early stages of learning Racket, and decided to have a go at the tower of Hanoi. I did this without any reference whatsoever, so everything is up for review, including the algorithm as well as my code.

In order to move n disks from a from peg to a to peg, we need to...

  1. move the top n-1 disks from from to free
  2. move the remaining single disk from from to to
  3. move n-1 disks from free to to

You then do exactly the same for the next n-1 pegs, and keep repeating until you've finished. This is clearly a recursive algorithm.

In order to work out which is the free peg, I realised that if you number the pegs 1, 2 and 3, then the sum of all three is always 6, so the number of the free peg is going to be 6 - (from + to). This led to my first utility function...

  (define (free-peg from to)
    (- 6 (+ from to)))

Then I needed a function to move a tower of n disks to one peg to another. Following the three steps shown above, I came up with this...

  (define (move-tower n from to)
    (if (= n 0)
        empty
        (append (move-tower (- n 1) from (free-peg from to))   ; step 1
                (list (list from to))                          ; step 2
                (move-tower (- n 1) (free-peg from to) to)))   ; step 3
    )

I then needed to call this function, passing in the number of disks, and the start and end peg numbers. This gave me the following...

(define (hanoi n)
  (define (free-peg from to)
    (- 6 (+ from to)))
  (define (move-tower n from to)
    (if (= n 0)
        empty
        (append (move-tower (- n 1) from (free-peg from to))
                (list (list from to))
                (move-tower (- n 1) (free-peg from to) to)))
    )
  (move-tower n 1 3))

This seems to work correctly, and gives a list of 2-tuples, each of which tells you the from and to peg for that step. For example, a 3 disk solution is...

'((1 3) (1 2) (3 2) (1 3) (2 1) (2 3) (1 3))

Anyone able to comment on my code? Specifically, I run out of memory when I give it a large number of disks. I've been reading about tail recursion, but don't understand it well enough to know if it would help me here. Would that enable me to run this with bigger numbers?

Thanks for any advice you can give. Remember, I'm very new at Racket (and Lisp in general), so please explain in words of one syllable!

\$\endgroup\$

2 Answers 2

5
\$\begingroup\$

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))))
\$\endgroup\$
3
  • \$\begingroup\$ Wow, what a great answer! It's going to take me some time to go through it, but I can see it's very clear and explanatory. As I've already accepted ferada's answer, I feel wrong to accept yours (especially as it's nearly three years later), but wanted to express my thanks for the help. \$\endgroup\$ Mar 25 at 14:44
  • \$\begingroup\$ Thanks. I hope that you can find some useful bits in my answer. "As I've already accepted ferada's answer...." -- Of course, you should accept whatever answer you see fit to accept, but I don't see an indication that any answer has been accepted at this point. \$\endgroup\$ Mar 25 at 19:17
  • \$\begingroup\$ Oops, my bad! I misread the tick below the score on the other answer and thought I'd accepted that one. Accepted your answer now. Thanks again \$\endgroup\$ Mar 25 at 20:07
3
\$\begingroup\$

The code looks fine, though I'd suggest to follow the usual Lisp style and not having dangling parentheses around:

(define (hanoi n)
  (define (free-peg from to)
    (- 6 (+ from to)))
  (define (move-tower n from to)
    (if (= n 0)
        empty
        (append (move-tower (- n 1) from (free-peg from to))
                (list (list from to))
                (move-tower (- n 1) (free-peg from to) to))))
  (move-tower n 1 3))

The nested functions are fine, even elegant.

With regards to optimisation, Tail Call Optimisation won't help you here, since you're still calling append and there's simply no tail calls to optimise. However, look into memoisation, e.g. the memoize library (documentation here):

(require memoize)

(define (hanoi n)
  (define (free-peg from to)
    (- 6 from to))
  (define/memo (move-tower n from to)
    (if (= n 0)
        empty
        (append (move-tower (- n 1) from (free-peg from to))
                (list (list from to))
                (move-tower (- n 1) (free-peg from to) to))))
  (move-tower n 1 3))

With that, (hanoi 20) doesn't crash, it just takes a very long time to print the result, as expected.

Note that I didn't memoise the overall result, but the actual recursive calls, memoising free-peg isn't useful here either, since it's such a small function.

\$\endgroup\$
2
  • 1
    \$\begingroup\$ Thanks for that. The reason for the dangling bracket was that whilst timing the function, I added a "0" as the last expression, to save DrRacket printing the full list out (which often took longer than the execution!). I removed the zero when I posted here, but forgot to shift the closing bracket back up :) \$\endgroup\$ Jun 1, 2021 at 14:43
  • 1
    \$\begingroup\$ Thanks also for directing me to memoize. I had just read about memoisation last night, but the book I was reading showed how to write your own code. Good to know there's a library for it (although writing your own code is a great way to understand what's going on). Thanks again. \$\endgroup\$ Jun 1, 2021 at 14:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.