; 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)))
OyBzb3J0IGZvdXIKCihkZWZpbmUgKHBlcm11dGF0aW9ucyB4cykKICAoZGVmaW5lIChyZXYgeHMgbiB5cykKICAgIChpZiAoemVybz8gbikgeXMKICAgICAgKHJldiAoY2RyIHhzKSAoLSBuIDEpIChjb25zIChjYXIgeHMpIHlzKSkpKQogIChsZXQgKCh4cyB4cykgKHBlcm1zIChsaXN0IHhzKSkpCiAgICAoZGVmaW5lIChwZXJtIG4pCiAgICAgIChpZiAoPiBuIDEpCiAgICAgICAgICAoZG8gKChqICgtIG4gMSkgKC0gaiAxKSkpCiAgICAgICAgICAgICAgKCh6ZXJvPyBqKSAocGVybSAoLSBuIDEpKSkKICAgICAgICAgICAgKHBlcm0gKC0gbiAxKSkKICAgICAgICAgICAgKHNldCEgeHMgKHJldiB4cyBuIChsaXN0LXRhaWwgeHMgbikpKQogICAgICAgICAgICAoc2V0ISBwZXJtcyAoY29ucyB4cyBwZXJtcykpKSkpCiAgICAocGVybSAobGVuZ3RoIHhzKSkKICAgIHBlcm1zKSkKCihkZWZpbmUgKHNvcnQ0IGEgYiBjIGQpCiAgKGxldCAoKGFiIChpZiAoPCBhIGIpIChsaXN0IGEgYikgKGxpc3QgYiBhKSkpCiAgICAgICAgKGNkIChpZiAoPCBjIGQpIChsaXN0IGMgZCkgKGxpc3QgZCBjKSkpKQogICAgKGxldCAoKGZpcnN0ICNmKSAobWlkMSAjZikgKG1pZDIgI2YpIChsYXN0ICNmKSkKICAgICAgKGNvbmQgKCg8IChjYXIgYWIpIChjYXIgY2QpKQogICAgICAgICAgICAgIChzZXQhIGZpcnN0IChjYXIgYWIpKQogICAgICAgICAgICAgIChzZXQhIG1pZDEgKGNhciBjZCkpKQogICAgICAgICAgICAoZWxzZQogICAgICAgICAgICAgIChzZXQhIGZpcnN0IChjYXIgY2QpKQogICAgICAgICAgICAgIChzZXQhIG1pZDEgKGNhciBhYikpKSkKICAgICAgKGNvbmQgKCg8IChjYWRyIGFiKSAoY2FkciBjZCkpCiAgICAgICAgICAgICAgKHNldCEgbGFzdCAoY2FkciBjZCkpCiAgICAgICAgICAgICAgKHNldCEgbWlkMiAoY2FkciBhYikpKQogICAgICAgICAgICAoZWxzZQogICAgICAgICAgICAgIChzZXQhIGxhc3QgKGNhZHIgYWIpKQogICAgICAgICAgICAgIChzZXQhIG1pZDIgKGNhZHIgY2QpKSkpCiAgICAgIChpZiAoPCBtaWQxIG1pZDIpCiAgICAgICAgICAobGlzdCBmaXJzdCBtaWQxIG1pZDIgbGFzdCkKICAgICAgICAgIChsaXN0IGZpcnN0IG1pZDIgbWlkMSBsYXN0KSkpKSkKCihmb3ItZWFjaAogIChsYW1iZGEgKHhzKQogICAgKGRpc3BsYXkgeHMpIChkaXNwbGF5ICIgPT4gIikKICAgIChkaXNwbGF5IChhcHBseSBzb3J0NCB4cykpIChuZXdsaW5lKSkKICAocGVybXV0YXRpb25zICcoMSAyIDMgNCkpKQ==