M.Hiroi's Home Page

お気楽 Scheme プログラミング入門

入門編 : 集合としてのリスト

Copyright (C) 2007-2020 Makoto Hiroi
All rights reserved.

はじめに

今回はリストを使って「集合 (set)」を表してみましょう。集合はいくつかの要素を集めたものです。一般に、集合は重複した要素を含まず、要素の順番に意味はありません。なお、要素の重複を許す集合は「多重集合 (multi set)」と呼ばれます。たとえば、集合 {1, 3, 5, 7} は {7, 5, 3, 1} や {5, 3, 1, 7} と表すこともできます。このように、要素は適当に並べてもかまわないのですが、ある規則で要素を整列させておく場合 (正規化) もあります。

集合をリストで表す場合、関数 member は要素が集合に含まれているか調べる述語と考えることができます。このほかにも、集合 A は集合 B の部分集合か調べたり、集合 A と B の和や積を求める、といった操作を考えることができます。また、空集合は空リストで表すことができます。

なお、ライブラリ SRFI-1 にはリストを集合として扱う関数が用意されていますが、今回は Scheme のお勉強ということで、実際にプログラムを作ってみましょう。

●union

それでは、集合の和を求める関数 union から作りましょう。関数 union は等値を判定する述語と 2 つのリスト (集合) を受け取り、2 つの集合の要素をすべて含むリストを返します。このとき、2 つの集合で重複している要素はひとつだけ結果のリストに含まれます。簡単な例を示しましょう。

gosh[r7rs.user]> (union eq? '(a b c) '(d e f))
(a b c d e f)
gosh[r7rs.user]> (union eq? '(a b c) '(c b d))
(a c b d)

union は append と同じように作ることができます。第 1 引数のリストから要素を取り出し、それが第 2 引数のリストに含まれていなければ、その要素を結果のリストに追加します。含まれていれば、その要素は追加しません。そして最後に、第 2 引数のリストを追加します。プログラムは次のようになります。

リスト : 集合の和

(define (union pred xs ys)
  (cond
   ((null? xs) ys)
   ((member (car xs) ys pred)
    (union pred (cdr xs) ys))
   (else
    (cons (car xs) (union pred (cdr xs) ys)))))

リスト xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。含まれていれば union を再帰呼び出します。そうでなければ、union を再帰呼び出しした結果に要素を追加します。

●intersection

次は集合の積を求める関数 intersection を作ります。intersection は 2 つのリストに共通な要素を取り出し、それをリストに格納して返します。簡単な例を示しましょう。

gosh[r7rs.user]> (intersection eq? '(a b c) '(b c d))
(c b)
gosh[r7rs.user]> (intersection eq? '(a b c) '(d e f))
()

プログラムは次のようになります。

リスト : 集合の積

(define (intersection pred xs ys)
  (cond
   ((null? xs) '())
   ((member (car xs) ys pred)
    (cons (car xs) (intersection pred (cdr xs) ys)))
   (else
    (intersection pred (cdr xs) ys))))

これも簡単ですね。リスト xs が空リストの場合は空リストを返します。次に、xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。そうであれば、intersection を再帰呼び出しした結果に要素を追加します。そうでなければ、intersection を再帰呼び出しするだけです。

●difference

次は集合の差を求める関数 difference を作ります。difference は集合 ys に現れない集合 xs の要素をリストに格納して返します。つまり、集合 xs から集合 ys に含まれる要素を取り除いた集合を求めることになります。簡単な例を示しましょう。

gosh[r7rs.user]> (difference eq? '(a b c d e) '(b d f))
(a c e)
gosh[r7rs.user]> (difference eq? '(a b c) '(a b c))
()

プログラムは次のようになります。

リスト : 集合の差

(define (difference pred xs ys)
  (cond
   ((null? xs) '())
   ((member (car xs) ys pred)
    (difference pred (cdr xs) ys))
   (else
    (cons (car xs) (difference pred (cdr xs) ys)))))

これも簡単ですね。リスト xs が空リストの場合は空リストを返します。次に、xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。含まれていれば、difference を再帰呼び出しします。そうでなければ、difference を再帰呼び出しした結果に要素を追加します。

●exclusive-or

次は、集合の排他的論理和を求める関数 exclusive-or を作りましょう。exclusive-or は集合 xs と ys の両方にちょうど 1 つだけ現れる要素をリストに格納して返します。これは集合の和から集合の積を取り除けば求めることができます。簡単な例を示しましょう。

gosh[r7rs.user]> (exclusive-or eq? '(a b c d e f) '(d e f b g h))
(a c g h)
gosh[r7rs.user]> (exclusive-or eq? '(a b c d e f) '(a b c d e f))
()
gosh[r7rs.user]> (exclusive-or eq? '(a b c) '(d e f))
(a b c d e f)

プログラムは次のようになります。

リスト : 集合の排他的論理和

(define (exclusive-or pred xs ys)
  (difference pred (union pred xs ys) (intersection pred xs ys)))

排他的論理和の定義をそのままプログラムしただけなので簡単です。

●subset?

次は集合 xs が集合 ys の部分集合か判定する述語 subset? を作ります。集合 xs の要素がすべて集合 ys に含まれていれば #t を返します。簡単な例を示しましょう。

gosh[r7rs.user]> (subset? eq? '(a b) '(a b c))
#t
gosh[r7rs.user]> (subset? eq? '(a b d) '(a b c))
#f

プログラムは次のようになります。

リスト : 部分集合の判定

(define (subset? pred xs ys)
  (cond
   ((null? xs) #t)
   ((member (car xs) ys pred)
    (subset? pred (cdr xs) ys))
   (else #f)))

xs が空リストの場合、xs のすべての要素は ys に含まれているので #t を返します。また、空リストは空集合を表しているので、空集合はすべての集合の部分集合であることを意味しています。次に、リスト xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。含まれていれば、subset? を再帰呼び出しするだけです。そうでなければ、集合 ys と異なる要素があるので #f を返します。

●adjoin

最後に、要素を集合に追加する関数 adjoin を作りましょう。

adjoin pred ls item1 item2 ...

adjoin は集合 ls に要素 item1 item2 ... を追加します。集合 ls に含まれている要素は追加しないことに注意してください。簡単な例を示しましょう。

gosh[r7rs.user]> (adjoin eq? '(a b c) 'd 'e 'f)
(f e d a b c)
gosh[r7rs.user]> (adjoin eq? '(a b c) 'a 'b 'd)
(d a b c)
gosh[r7rs.user]> (apply adjoin eq? '() '(a b a b c a b c d))
(d c b a)

最後の例のように、adjoin は重複要素を削除することもできます。プログラムは次のようになります。

リスト : 要素の追加

(define (adjoin pred ls . xs)
  (let loop ((xs xs) (ls ls))
    (cond
     ((null? xs) ls)
     ((member (car xs) ls pred)
      (loop (cdr xs) ls))
     (else
      (loop (cdr xs) (cons (car xs) ls))))))

追加する要素は可変個引数で受け取ります。名前付き let で xs から要素を一つずつ取り出し、それが集合 ls に含まれているか member でチェックします。含まれていれば、その要素は ls に追加しません。含まれていなければ要素を ls に追加します。

●ライブラリの作成

プログラムを作っていると、ほかのプログラムで作った関数が利用できるのではないか、といった場面に出あうことがあります。このような場合、自分で作成した関数をライブラリとしてまとめておくと、簡単に再利用することができて便利です。R7RS-small では、define-library でライブラリを定義することができます。ここで define-library の基本的な使い方を簡単に説明しておきましょう。

define-library (library name) (library declaration) ...

(library name) はライブラリ名を表すリストで、その要素は識別子 (シンボル) もしくは非負の整数です。(library declaration) はライブラリ宣言を表します。これにはいくつかの形式がありますが、ライブラリとして最低限必要になるのは export 宣言、import 宣言、begin 宣言の 3 つです。

  1. (export name ...)
  2. (import (library name) ...)
  3. (begin S式 ...)

1 の export 宣言はライブラリ外部に公開する識別子などを指定します。(rename name1 name2) で公開する名前を変更することもできます。2 の import 宣言はライブラリで必要となる他のライブラリを import します。3 の begin 宣言は、ライブラリ本体である Scheme コード (S 式) を begin フォームに記述します。

簡単な例を示しましょう。

リスト : ライブラリ (mylib foo) の定義

(define-library (mylib foo)
  (export foo)
  (import (scheme base) (scheme write))
  (begin
    (define (foo) (display "hello, foo!\n"))))

ライブラリ名が (mylib foo) で、begin の中に関数 foo が定義されています。そして export 宣言で foo を外部に公開しています。ライブラリ名 (mylib foo) と実際のファイルとの対応は、仕様 (R7RS-small) では未定義なので Scheme 処理系に依存します。Gauche の場合、ライブラリ名は次のようなファイル名に変換されます。

(mylib foo) => mylib/foo.scm
(mylib test bar) => mylib/test/bar.scm

(mylib foo) はディレクトリ mylib/ にある foo.scm を表します。(mylib test bar) はディレクトリ mylib/test/ の bar.scm を表します。たとえば、カレントディレクトリに mylib/foo.scm があるとしましょう。Gauche の場合、REPL で (import (mylib foo)) としてもライブラリをロードすることはできません。

$ rlwrap gosh -r7
gosh[r7rs.user]> (import (mylib foo))
*** ERROR: cannot find "mylib/foo" in ("/usr/local/share/gauche-0.97/site/lib" 
"/usr/local/share/gauche-0.97/0.9.9/lib")
    While compiling "(standard input)" at line 1: (import (mylib foo))

Gauche はライブラリを検索するとき *load-path* に登録されているパスを使用します。カレントディレクトリは *load-path* に登録されていないので、mylib/foo.scm を読み込むことができないのです。一番簡単な方法は Gauche の起動時にオプション -A または -I を使って、カレントディレクトリを *load-path* に追加することです。

$ rlwrap gosh -r7 -A .
gosh[r7rs.user]> (import (mylib foo))
gosh[r7rs.user]> (foo)
hello, foo!
#<undef>

これでライブラリ (mylib foo) を読み込むことができます。それから、今回作成した集合演算を行う関数をライブラリ (mylib lset) にまとめると、ログラムリストのようになります。ご参考までに。

●プログラムリスト

;;;
;;; lset.scm : リストによる集合演算
;;;
;;;            Copyright (C) 2020 by Makoto Hiroi
;;;
(define-library (mylib lset)
  (import (scheme base))
  (export adjoin union intersection difference exclusive-or subset?)
  (begin
    ;; 要素の追加
    (define (adjoin pred ls . xs)
      (let loop ((xs xs) (ls ls))
        (cond
         ((null? xs) ls)
         ((member (car xs) ls pred)
          (loop (cdr xs) ls))
         (else
          (loop (cdr xs) (cons (car xs) ls))))))

    ;; 和集合
    (define (union pred xs ys)
      (cond
       ((null? xs) ys)
       ((member (car xs) ys pred)
        (union pred (cdr xs) ys))
       (else
        (cons (car xs) (union pred (cdr xs) ys)))))

    ;; 積集合
    (define (intersection pred xs ys)
      (cond
       ((null? xs) '())
       ((member (car xs) ys pred)
        (cons (car xs) (intersection pred (cdr xs) ys)))
       (else
        (intersection pred (cdr xs) ys))))

    ;; 差集合
    (define (difference pred xs ys)
      (cond
       ((null? xs) '())
       ((member (car xs) ys pred)
        (difference pred (cdr xs) ys))
       (else
        (cons (car xs) (difference pred (cdr xs) ys)))))

    ;; 排他的論理和
    (define (exclusive-or pred xs ys)
      (difference pred (union pred xs ys) (intersection pred xs ys)))

    ;; 部分集合
    (define (subset? pred xs ys)
      (cond
       ((null? xs) #t)
       ((member (car xs) ys pred)
        (subset? pred (cdr xs) ys))
       (else #f)))
    ))

簡単な使用例を示します。

$ rlwrap gosh -r7 -A .
gosh[r7rs.user]> (import (mylib lset))
gosh[r7rs.user]> (union eq? '(a b c d) '(c d e f))
(a b c d e f)
gosh[r7rs.user]> (intersection eq? '(a b c d) '(c d e f))
(c d)
gosh[r7rs.user]> (difference eq? '(a b c d) '(c d e f))
(a b)

初版 2008 年 2 月 2 日
改訂 2020 年 9 月 6 日