; sort four (define (permutations xs) (define (rev xs n ys) (if (zero? n) ys (rev (cdr xs) (- n 1) (cons (car xs) ys)))) (let ((xs xs) (perms (list xs))) (define (perm n) (if (> n 1) (do ((j (- n 1) (- j 1))) ((zero? j) (perm (- n 1))) (perm (- n 1)) (set! xs (rev xs n (list-tail xs n))) (set! perms (cons xs perms))))) (perm (length xs)) perms)) (define (sort4 a b c d) (let ((ab (if (< a b) (list a b) (list b a))) (cd (if (< c d) (list c d) (list d c)))) (let ((first #f) (mid1 #f) (mid2 #f) (last #f)) (cond ((< (car ab) (car cd)) (set! first (car ab)) (set! mid1 (car cd))) (else (set! first (car cd)) (set! mid1 (car ab)))) (cond ((< (cadr ab) (cadr cd)) (set! last (cadr cd)) (set! mid2 (cadr ab))) (else (set! last (cadr ab)) (set! mid2 (cadr cd)))) (if (< mid1 mid2) (list first mid1 mid2 last) (list first mid2 mid1 last))))) (for-each (lambda (xs) (display xs) (display " => ") (display (apply sort4 xs)) (newline)) (permutations '(1 2 3 4)))