[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/4CinTQQM    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Nov 30:
; median of five

(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-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (if (not (equal? expr result))
          (for-each display `(
            #\newline "failed assertion:" #\newline
            expr #\newline "expected: " ,result
            #\newline "returned: " ,expr #\newline))))))

(define (median5 lt? a b c d e)
  (when (lt? b a)
    (let ((t a)) (set! a b) (set! b t)))
  (when (lt? e d)
    (let ((t d)) (set! d e) (set! e t)))
  (when (lt? d a)
    (let ((t a)) (set! a d) (set! d t))
    (let ((t b)) (set! b e) (set! e t)))
  (if (lt? b c)
      (if (lt? b d)
          (if (lt? c d) c d)
          (if (lt? b e) b e))
      (if (lt? d c)
          (if (lt? c e) c e)
          (if (lt? b d) b d))))

; no news is good news
(for-each (lambda (perm) (assert (apply median5 < perm) 3))
          (permutations '(1 2 3 4 5)))

(display (median5 < 1 2 3 4 5)) (newline)
(display (median5 < 5 4 3 2 1)) (newline)


Output:
1
2
3
3


Create a new paste based on this one


Comments: