yaotti's diary

Software is Eating the World

merge sort

gaucheマージソート
きちんとテストも書いてみた.


sort-merge.scm

;; merge-sort
(use srfi-1)
(define (merge-sort l)
  (let ((len (length l)))
    (cond [(>= len 2)
	   (merge (merge-sort (former l))
		  (merge-sort (latter l)))]
	  [else l]
	  )))

(define (merge l1 l2)
  (cond [(null? l1)
	 l2]
	[(null? l2)
	 l1]
	[(< (car l1) (car l2))
	 (cons (car l1) (merge (cdr l1) l2))]
	[else
	 (cons (car l2) (merge l1 (cdr l2)))]
	))

;; the former part of the list
(define (former l) 
  (let* ((len (length l))
	 (s (ceiling (/ len 2))))
    (take l s)))

;; the latter part of the list
(define (latter l)
  (let* ((len (length l))
	 (s (ceiling (/ len 2))))
    (drop l s)))

テストプログラム(test-merge.scm)

;; test code
(use gauche.test)

(add-load-path ".")
(load "sort-merge")

(test-start "merge sort test")

(test-section "test merge func")
(test* "merge (2 4 6) (1 3 5)" '(1 2 3 4 5 6) (merge '(2 4 6) '(1 3 5)))
(test* "merge (1 2) (1 3)" '(1 1 2 3) (merge '(1 2) '(1 3)))

(test-section "test former/latter list")
(test* "former (1 2 3 4 5)" '(1 2 3) (former '(1 2 3 4 5)))
(test* "former (1 2 3 4)" '(1 2) (former '(1 2 3 4)))
(test* "former ()" '() (former '()))
(test* "latter (1 2 3 4 5)" '(4 5) (latter '(1 2 3 4 5)))
(test* "latter (1 2 3 4)" '(3 4) (latter '(1 2 3 4)))
(test* "latter ()" '() (latter '()))

(test-section "test merge sort")
(test* "merge (2 4 3 5 1 6)" '(1 2 3 4 5 6) (merge-sort '(2 4 3 5 1 6)))
(test* "merge (1 2 3)" '(1 2 3) (merge-sort '(1 2 3)))
(test* "merge (1)" '(1) (merge-sort '(1)))
(test* "merge ()" '() (merge-sort '()))

(test-end)


テスト

$ gosh test-merge.scm
Testing merge sort test ...                                      
<test merge func>--------------------------------------------------------------
test merge (2 4 6) (1 3 5), expects (1 2 3 4 5 6) ==> ok
test merge (1 2) (1 3), expects (1 1 2 3) ==> ok
<test former/latter list>------------------------------------------------------
test former (1 2 3 4 5), expects (1 2 3) ==> ok
test former (1 2 3 4), expects (1 2) ==> ok
test former (), expects () ==> ok
test latter (1 2 3 4 5), expects (4 5) ==> ok
test latter (1 2 3 4), expects (3 4) ==> ok
test latter (), expects () ==> ok
<test merge sort>--------------------------------------------------------------
test merge (2 4 3 5 1 6), expects (1 2 3 4 5 6) ==> ok
test merge (1 2 3), expects (1 2 3) ==> ok
test merge (1), expects (1) ==> ok
test merge (), expects () ==> ok
passed.