[ create a new paste ] login | about

Link: http://codepad.org/LcWgWQCp    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jul 3:
; minimum and maximum

(define (first-min-max xs)
  (if (null? xs) (error 'first-min-max "empty input")
    (list (apply min xs) (apply max xs))))

(display (first-min-max '(1))) (newline)
(display (first-min-max '(1 1))) (newline)
(display (first-min-max '(1 2 3 4 5))) (newline)
(display (first-min-max '(5 4 3 2 1))) (newline)

(define (sort2 xs)
  (if (null? (cdr xs)) (values (car xs) (car xs))
    (if (< (car xs) (cadr xs)) (values (car xs) (cadr xs))
      (values (cadr xs) (car xs)))))

(define (drop2 xs) (if (null? (cdr xs)) '() (cddr xs)))

(define (first-min-max xs)
  (if (null? xs) (error 'first-min-max "empty input")
    (let loop ((mn (car xs)) (mx (car xs)) (xs (cdr xs)))
      (if (null? xs) (list mn mx)
        (call-with-values (lambda () (sort2 xs))
          (lambda (a b) (loop (if (< a mn) a mn) (if (< mx b) b mx) (drop2 xs))))))))

(display (first-min-max '(1))) (newline)
(display (first-min-max '(1 1))) (newline)
(display (first-min-max '(1 2 3 4 5))) (newline)
(display (first-min-max '(5 4 3 2 1))) (newline)

(define (second-min-max xs)
  (if (or (null? xs) (null? (cdr xs)))
      (error 'second-min-max "insufficient input")
      (call-with-values (lambda () (sort2 xs))
        (lambda (mn mx)
          (let ((mn1 mn) (mn2 mx) (mx2 mn) (mx1 mx))
            (do ((xs (drop2 xs) (drop2 xs)))
                ((null? xs) (list mn2 mx2))
              (if (null? (cdr xs))
                  (begin
                    (when (< (car xs) mn2)
                      (if (< (car xs) mn1)
                          (begin (set! mn2 mn1)
                                 (set! mn1 (car xs)))
                          (set! mn2 (car xs))))
                    (when (> (car xs) mx2)
                      (if (> (car xs) mx1)
                          (begin (set! mx2 mx1)
                                 (set! mx1 (car xs)))
                          (set! mx2 (car xs)))))
                  (call-with-values (lambda () (sort2 xs))
                    (lambda (mn mx)
                      (when (< mn mn2)
                        (if (< mn mn1)
                            (begin (set! mn2 (min mn2 mx))
                                   (set! mn1 mn))
                            (set! mn2 mn)))
                      (when (> mx mx2)
                        (if (> mx mx1)
                            (begin (set! mx2 (max mx2 mn))
                                   (set! mx1 mx))
                            (set! mx2 mx))))))))))))

(display (second-min-max '(1 1))) (newline)
(display (second-min-max '(1 2 3 4))) (newline)
(display (second-min-max '(4 3 2 1))) (newline)
(display (second-min-max '(1 2 3 4 5))) (newline)
(display (second-min-max '(5 4 3 2 1))) (newline)


Output:
1
2
3
4
5
6
7
8
9
10
11
12
13
(1 1)
(1 1)
(1 5)
(1 5)
(1 1)
(1 1)
(1 5)
(1 5)
(1 1)
(2 3)
(2 3)
(2 4)
(2 4)


Create a new paste based on this one


Comments: