hanoi
An always classic:
(define ( hanoi n src dst tmp s)
(if (= n 1) (print "move from " src " to " dst )
(hanoi (- n 1) tmp dst src (hanoi 1 src dst tmp (hanoi (- n 1) src tmp dst s)))))
(hanoi 3 0 1 2 '() )
(exit)
Version 2:
(define (pass-stack stack src dst)
(if (null? stack ) '()
(if (= src 0) (cons (- (car stack) 1) (pass-stack (cdr stack) (- src 1) (- dst 1) ))
(if (= dst 0) (cons (+ (car stack) 1) (pass-stack (cdr stack) (- src 1) (- dst 1) ))
(if (and (< dst 0) (< src 0)) stack
(cons (car stack) (pass-stack (cdr stack) (- src 1) (- dst 1))))))))
(define (print-move stack src dst)
(print (pass-stack stack src dst)))
(define (hanoi n src dst tmp stack)
(if (= n 1) (print-move stack src dst )
(hanoi (- n 1) tmp dst src (hanoi 1 src dst tmp ( hanoi (- n 1) src tmp dst stack)))))
(hanoi 3 0 1 2 '(3 0 0) )
(exit)
Version 3:
(define stacks (list '(1 2 3 4 5) '() '()))
(define (build-stacks a b c la lb lc)
(if (< a b c) (list la lb lc)
(if (< a c b) (list la lc lb)
(if (< b a c) (list lb la lc)
(if (< b c a) (list lb lc la)
(if (< b a c) (list lb la lc)
(if (< c a b) (list lc la lb)
(list lc lb la))))))))
(define (move stack src dst tmp)
(build-stacks src dst tmp
(cdr (list-ref stack src))
(cons (car (list-ref stack src)) (list-ref stack dst))
(list-ref stack tmp)))
(define (print-move stack src dst tmp)
(and (print (move stack src dst tmp)) (move stack src dst tmp)))
(define (hanoi n stack src dst tmp)
(if (= n 1)
(print-move stack src dst tmp)
(hanoi (- n 1) (hanoi 1 (hanoi (- n 1) stack src tmp dst) src dst tmp) tmp dst src)))
(hanoi 5 stacks 0 1 2)
(exit)
(define ( hanoi n src dst tmp s)
(if (= n 1) (print "move from " src " to " dst )
(hanoi (- n 1) tmp dst src (hanoi 1 src dst tmp (hanoi (- n 1) src tmp dst s)))))
(hanoi 3 0 1 2 '() )
(exit)
Version 2:
(define (pass-stack stack src dst)
(if (null? stack ) '()
(if (= src 0) (cons (- (car stack) 1) (pass-stack (cdr stack) (- src 1) (- dst 1) ))
(if (= dst 0) (cons (+ (car stack) 1) (pass-stack (cdr stack) (- src 1) (- dst 1) ))
(if (and (< dst 0) (< src 0)) stack
(cons (car stack) (pass-stack (cdr stack) (- src 1) (- dst 1))))))))
(define (print-move stack src dst)
(print (pass-stack stack src dst)))
(define (hanoi n src dst tmp stack)
(if (= n 1) (print-move stack src dst )
(hanoi (- n 1) tmp dst src (hanoi 1 src dst tmp ( hanoi (- n 1) src tmp dst stack)))))
(hanoi 3 0 1 2 '(3 0 0) )
(exit)
Version 3:
(define stacks (list '(1 2 3 4 5) '() '()))
(define (build-stacks a b c la lb lc)
(if (< a b c) (list la lb lc)
(if (< a c b) (list la lc lb)
(if (< b a c) (list lb la lc)
(if (< b c a) (list lb lc la)
(if (< b a c) (list lb la lc)
(if (< c a b) (list lc la lb)
(list lc lb la))))))))
(define (move stack src dst tmp)
(build-stacks src dst tmp
(cdr (list-ref stack src))
(cons (car (list-ref stack src)) (list-ref stack dst))
(list-ref stack tmp)))
(define (print-move stack src dst tmp)
(and (print (move stack src dst tmp)) (move stack src dst tmp)))
(define (hanoi n stack src dst tmp)
(if (= n 1)
(print-move stack src dst tmp)
(hanoi (- n 1) (hanoi 1 (hanoi (- n 1) stack src tmp dst) src dst tmp) tmp dst src)))
(hanoi 5 stacks 0 1 2)
(exit)
0 Comments:
Post a Comment
<< Home