merge-sort in mzscheme.

merge-sort.scm

#lang mzscheme

(define-syntax equal??
  (syntax-rules ()
    ((_ test-exp correct-ans)
     (let ((observed-ans test-exp))
       (if (not (equal? observed-ans correct-ans))
           (printf "Failed : ~s returned ~s, should have returned ~s~%"
                   'test-exp
                   observed-ans
                   correct-ans)
           (printf "Success: ~s returned ~s expectedly~%"
                   'test-exp
                   observed-ans)
           )))))

;; merge : List -> List -> List
;;  usage (merge sorted1 sorted2) -> merged sorted list.
;;  ex (merge '(1 2 5) '(2 3 5 6)) -> '(1 2 2 3 5 5 6)
(define merge (lambda (left right pred)
                (cond
                 [(and (null? left) (null? right)) '()]
                 [(null? left)                     right]
                 [(null? right)                    left]
                 [else (if (pred (car left) (car right))
                           (cons (car left) (merge (cdr left) right pred))
                           (cons (car right) (merge left (cdr right) pred)))]
                 )))

;; take-head : List -> N -> List
;; take-head List N -> first N element of List.
(define take-head (lambda (ls n)
                    (car (_take ls n '()))))

;; take-tail : List -> N -> List
;; take-tail List N -> rest element.
(define take-tail (lambda (ls n)
                    (cadr (_take ls n '()))))

;; helper function for take-head and take-tail.
;;  _take : List -> N -> '(List List)
;;  _take List -> N -> '("first N element of List" "Rest")
(define _take (lambda (ls n head)
  (if (= n 0)
      (cons (reverse head) (cons ls '()))
      (_take (cdr ls) (- n 1) (cons (car ls) head)))))

;; merge-sort : List of A -> (A -> A -> bool)  -> List
;;  merge-sort List function -> sorted list using function.
(define merge-sort (lambda (ls pred)
                     (cond
                      [(or (= (length ls) 0) (= (length ls) 1)) ls]
                      [(= (length ls) 2)
                       (if (pred (list-ref ls 0) (list-ref ls 1))
                           ls
                           (reverse ls))]
                      [else
                       (let ((head (take-head ls (floor (/ (length ls) 2))))
                             (tail (take-tail ls (floor (/ (length ls) 2)))))
                         (merge (merge-sort head pred)
                                (merge-sort tail pred)
                                pred))]
                      )))

(equal?? (merge-sort '() <) '())
(equal?? (merge-sort '(1) <) '(1))

(equal?? (merge-sort '(1 2 3) <) '(1 2 3))
(equal?? (merge-sort '(1 3 2) <) '(1 2 3))
(equal?? (merge-sort '(2 1 3) <) '(1 2 3))
(equal?? (merge-sort '(2 3 1) <) '(1 2 3))
(equal?? (merge-sort '(3 1 2) <) '(1 2 3))
(equal?? (merge-sort '(3 2 1) <) '(1 2 3))

(equal?? (merge-sort '(4 3 1 2) <) '(1 2 3 4))
(equal?? (merge-sort '(4 3 1 2) >) '(4 3 2 1))

(equal?? (merge-sort '(1 2 3 4 5 6) <) '(1 2 3 4 5 6))
(equal?? (merge-sort '(1 2 3 4 5 6) >) '(6 5 4 3 2 1))