表題

ソートとマージ

著者

Aubrey Jaffer

状態

この SRFI は現在「確定」の状態である。 SRFI の各状態の説明については ここ を参照せよ。 この SRFI に対するコメントは、 mail to <srfi minus 95 at srfi dot schemers dot org> 宛てにメールで送信してください。 このメーリングリストに参加する方法については、 ここの説明 を参照せよ。 この SRFI に関する議論については メーリングリストのアーカイブ を参照せよ。

概要

ソートとマージは有用な操作なので、API を共通化する価値がある。

課題

論拠

汎用的なソフトウェア ライブラリは、 シンプルで使いやすいものにすべきであり、 アルゴリズム設計における理論的な完璧さを求めてはいけない。 ソート ライブラリは、 多くのアプリケーションで一般的な適度なサイズの入力に対して、 適度な性能をもつように設計すべきである。 『SRFI 32: ソート ライブラリ』 が廃止されたとき、そこには 28 個の手続きが提案されていた。 汎用的なソート ライブラリにおいて多数の変種を抱えると、不都合なことが多い。 Wikipedia の Sorting algorithm の表を見ると、 merge-sort のクラスのアルゴリズムは、最良ケースを除いて、 漸近的な空間計算量と時間計算量において最適であることを示している。 最良ケースを達成するためには、 ソート アルゴリズムを 不安定 にしなければならない。

この SRFI のソート手続きは、リストと配列 (ベクタも含む) に対して作用する。 マージ手続きはリストに対して作用する。

SRFI 32 のベクタ関係の手続きでは、 操作をベクタの一部分に制限するためのオプション引数を受け取る。 SRFI 63 の共有部分配列を利用すれば (make-shared-array または SLIB の subarray を使えばよい)、 このようなオプション引数は不要になる。

この SRFI の手続きでは、 Common-Lisp の &KEY 引数と同じような、 オプションの手続き引数を指定することができる。

仕様

以下の手続きは、 同一の引数に対して #f を返す述語とともに呼び出したときに 安定した動作をする。

sorted?, merge, merge! 手続きの 漸近的な時間計算量と空間計算量は O(N) より大きくならない。 ここで N は各シーケンス引数の長さの和である。 sort と sort! 手続きの 漸近的な時間計算量と空間計算量は O(N*log(N)) より大きくならない。 ここで N はシーケンス引数の長さである。

この 5 つの関数はオプションで key 引数をとる。 これは CommonLisp スタイルの `&key' 引数である。 less? 述語に key 引数を指定すると、次のように振舞う。 

(lambda (x y) (less? (key x) (key y)))

この 5 つの関数は１要素に対して最大でも１回しか key 引数を呼び出さない。

名前に `!' が付いているバージョンは、インプレースでソートを行う。 sort! は sequence 引数を返す。

Function: sorted? sequence less?
Function: sorted? sequence less? key
引数のシーケンスが less? に関して非降順であれば (言い換えると、(less? y x) を満たすような隣接する要素 ... x y ... が存在しなければ) #t を返す。

そうでなければ #f を返す。 シーケンスがリストや配列 (ベクタや文字列も含む) でなければエラーである。

Function: merge list1 list2 less?
Function: merge list1 list2 less? key
２つのソート済みのリストをマージして、 新しく割り当てられたリストを返す。

Function: merge! list1 list2 less?
Function: merge! list1 list2 less? key
２つのソート済みのリストをマージし、 list1 と list2 のペアを再利用して戻り値を構築して返す。 戻り値は list1 または list2 のいずれかである。

Function: sort sequence less?
Function: sort sequence less? key
sequence はリストや配列である (ベクタや文字列も含む)。 less? によりソートされた完全に新しいシーケンスを返す。 返されるシーケンスは引数の sequence と同じ型である。 正しい引数が与えられた場合、常に次の式が満たされる。 
(sorted? (sort sequence less?) less?) => #t

Function: sort! sequence less?
Function: sort! sequence less? key
sequence はリスト、配列、ベクタ、文字列であり、 less? により破壊的にソートされて返される。 正しい引数が与えられた場合、常に次の式が満たされる。 
(sorted? (sort! sequence less?) less?) => #t

実装

slib/sort.scm は R4RS または R5RS に準拠する Scheme 処理系のための手続きを実装している。 配列は slib/array.scm または SRFI 63 により実装されていることを仮定している。 

;;; "sort.scm" Defines: sorted?, merge, merge!, sort, sort!
;;; Author : Richard A. O'Keefe (based on Prolog code by D.H.D.Warren)
;;;
;;; This code is in the public domain.

;;; Updated: 11 June 1991
;;; Modified for scheme library: Aubrey Jaffer 19 Sept. 1991
;;; Updated: 19 June 1995
;;; (sort, sort!, sorted?): Generalized to strings by jaffer: 2003-09-09
;;; (sort, sort!, sorted?): Generalized to arrays by jaffer: 2003-10-04
;;; jaffer: 2006-10-08:
;;; (sort, sort!, sorted?, merge, merge!): Added optional KEY argument.
;;; jaffer: 2006-11-05:
;;; (sorted?, merge, merge!, sort, sort!): Call KEY arg at most once
;;; per element.

(require 'array)

;;; (sorted? sequence less?)
;;; is true when sequence is a list (x0 x1 ... xm) or a vector #(x0 ... xm)
;;; such that for all 1 <= i <= m,
;;;     (not (less? (list-ref list i) (list-ref list (- i 1)))).
;@
(define (sorted? seq less? . opt-key)
  (define key (if (null? opt-key) identity (car opt-key)))
  (cond ((null? seq) #t)
	((array? seq)
	 (let ((dimax (+ -1 (car (array-dimensions seq)))))
	   (or (<= dimax 1)
	       (let loop ((idx (+ -1 dimax))
			  (last (key (array-ref seq dimax))))
		 (or (negative? idx)
		     (let ((nxt (key (array-ref seq idx))))
		       (and (less? nxt last)
			    (loop (+ -1 idx) nxt))))))))
	((null? (cdr seq)) #t)
	(else
	 (let loop ((last (key (car seq)))
		    (next (cdr seq)))
	   (or (null? next)
	       (let ((nxt (key (car next))))
		 (and (not (less? nxt last))
		      (loop nxt (cdr next)))))))))

;;; (merge a b less?)
;;; takes two lists a and b such that (sorted? a less?) and (sorted? b less?)
;;; and returns a new list in which the elements of a and b have been stably
;;; interleaved so that (sorted? (merge a b less?) less?).
;;; Note:  this does _not_ accept arrays.  See below.
;@
(define (merge a b less? . opt-key)
  (define key (if (null? opt-key) identity (car opt-key)))
  (cond ((null? a) b)
	((null? b) a)
	(else
	 (let loop ((x (car a)) (kx (key (car a))) (a (cdr a))
		    (y (car b)) (ky (key (car b))) (b (cdr b)))
	   ;; The loop handles the merging of non-empty lists.  It has
	   ;; been written this way to save testing and car/cdring.
	   (if (less? ky kx)
	       (if (null? b)
		   (cons y (cons x a))
		   (cons y (loop x kx a (car b) (key (car b)) (cdr b))))
	       ;; x <= y
	       (if (null? a)
		   (cons x (cons y b))
		   (cons x (loop (car a) (key (car a)) (cdr a) y ky b))))))))

(define (sort:merge! a b less? key)
  (define (loop r a kcara b kcarb)
    (cond ((less? kcarb kcara)
	   (set-cdr! r b)
	   (if (null? (cdr b))
	       (set-cdr! b a)
	       (loop b a kcara (cdr b) (key (cadr b)))))
	  (else				; (car a) <= (car b)
	   (set-cdr! r a)
	   (if (null? (cdr a))
	       (set-cdr! a b)
	       (loop a (cdr a) (key (cadr a)) b kcarb)))))
  (cond ((null? a) b)
	((null? b) a)
	(else
	 (let ((kcara (key (car a)))
	       (kcarb (key (car b))))
	   (cond
	    ((less? kcarb kcara)
	     (if (null? (cdr b))
		 (set-cdr! b a)
		 (loop b a kcara (cdr b) (key (cadr b))))
	     b)
	    (else			; (car a) <= (car b)
	     (if (null? (cdr a))
		 (set-cdr! a b)
		 (loop a (cdr a) (key (cadr a)) b kcarb))
	     a))))))

;;; takes two sorted lists a and b and smashes their cdr fields to form a
;;; single sorted list including the elements of both.
;;; Note:  this does _not_ accept arrays.
;@
(define (merge! a b less? . opt-key)
  (sort:merge! a b less? (if (null? opt-key) identity (car opt-key))))

(define (sort:sort-list! seq less? key)
  (define keyer (if key car identity))
  (define (step n)
    (cond ((> n 2) (let* ((j (quotient n 2))
			  (a (step j))
			  (k (- n j))
			  (b (step k)))
		     (sort:merge! a b less? keyer)))
	  ((= n 2) (let ((x (car seq))
			 (y (cadr seq))
			 (p seq))
		     (set! seq (cddr seq))
		     (cond ((less? (keyer y) (keyer x))
			    (set-car! p y)
			    (set-car! (cdr p) x)))
		     (set-cdr! (cdr p) '())
		     p))
	  ((= n 1) (let ((p seq))
		     (set! seq (cdr seq))
		     (set-cdr! p '())
		     p))
	  (else '())))
  (define (key-wrap! lst)
    (cond ((null? lst))
	  (else (set-car! lst (cons (key (car lst)) (car lst)))
		(key-wrap! (cdr lst)))))
  (define (key-unwrap! lst)
    (cond ((null? lst))
	  (else (set-car! lst (cdar lst))
		(key-unwrap! (cdr lst)))))
  (cond (key
	 (key-wrap! seq)
	 (set! seq (step (length seq)))
	 (key-unwrap! seq)
	 seq)
	(else
	 (step (length seq)))))

(define (rank-1-array->list array)
  (define dimensions (array-dimensions array))
  (do ((idx (+ -1 (car dimensions)) (+ -1 idx))
       (lst '() (cons (array-ref array idx) lst)))
      ((< idx 0) lst)))

;;; (sort! sequence less?)
;;; sorts the list, array, or string sequence destructively.  It uses
;;; a version of merge-sort invented, to the best of my knowledge, by
;;; David H. D.  Warren, and first used in the DEC-10 Prolog system.
;;; R. A. O'Keefe adapted it to work destructively in Scheme.
;;; A. Jaffer modified to always return the original list.
;@
(define (sort! seq less? . opt-key)
  (define key (if (null? opt-key) #f (car opt-key)))
  (cond ((array? seq)
	 (let ((dims (array-dimensions seq)))
	   (do ((sorted (sort:sort-list! (rank-1-array->list seq) less? key)
			(cdr sorted))
		(i 0 (+ i 1)))
	       ((null? sorted) seq)
	     (array-set! seq (car sorted) i))))
	(else			      ; otherwise, assume it is a list
	 (let ((ret (sort:sort-list! seq less? key)))
	   (if (not (eq? ret seq))
	       (do ((crt ret (cdr crt)))
		   ((eq? (cdr crt) seq)
		    (set-cdr! crt ret)
		    (let ((scar (car seq)) (scdr (cdr seq)))
		      (set-car! seq (car ret)) (set-cdr! seq (cdr ret))
		      (set-car! ret scar) (set-cdr! ret scdr)))))
	   seq))))

;;; (sort sequence less?)
;;; sorts a array, string, or list non-destructively.  It does this
;;; by sorting a copy of the sequence.  My understanding is that the
;;; Standard says that the result of append is always "newly
;;; allocated" except for sharing structure with "the last argument",
;;; so (append x '()) ought to be a standard way of copying a list x.
;@
(define (sort seq less? . opt-key)
  (define key (if (null? opt-key) #f (car opt-key)))
  (cond ((array? seq)
	 (let ((dims (array-dimensions seq)))
	   (define newra (apply make-array seq dims))
	   (do ((sorted (sort:sort-list! (rank-1-array->list seq) less? key)
			(cdr sorted))
		(i 0 (+ i 1)))
	       ((null? sorted) newra)
	     (array-set! newra (car sorted) i))))
	(else (sort:sort-list! (append seq '()) less? key))))

著作権

Copyright (C) Aubrey Jaffer 2006. All Rights Reserved.

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

編集者: David Van Horn