M.Hiroi's Home Page

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

多相ヴァリアント


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

はじめに

OCaml のヴァリアントはとても便利な機能ですが、一つのコンストラクタを複数のヴァリアント型で使用できない、という制限があります。この制限を取り払ったものが「多相ヴァリアント (polymorphic variant)」です。今回は多相ヴァリアントの基本について簡単に説明します。

●多相ヴァリアントの基本

多相ヴァリアントの場合、データ型を定義しなくてもコンストラクタを使用することができます。多相ヴァリアントのコンストラクタは名前の前にバッククオート ( ` ) を付けて表します。簡単な例を示しましょう。

# `Apple;;
- : [> `Apple ] = `Apple
# 'Orange;;
- : [> `Orange ] = `Orange
# [`Apple; `Orange];;
- : [> `Apple | `Orange ] list = [`Apple; `Orange]

多相ヴァリアントのデータ型は [ ... ] で表します。また、[ の後ろに > または < が付く場合があります。この違いはあとで説明します。

もちろん、多相型ヴァリアントでもコンストラクタに引数を渡すことができます。

# `Foo 1;;
- : [> `Foo of int ] = `Foo 1
# `Foo "abc";;
- : [> `Foo of string ] = `Foo "abc"
# `Foo (1, "abc");;
- : [> `Foo of int * string ] = `Foo (1, "abc")

このように、同じコンストラクタでも異なる引数の型を指定することができます。ただし、引数の型が異なる同名のコンストラクタをリストに混在させることはできません。

# [`Foo 1; `Foo "abc"]
... エラー (省略) ...

この場合、異なるデータ型として扱われるため、リストに格納することはできません。つまり、同じ型が必要なところでは混在させることができない、というわけです。次に示すように、組にすることは可能です。

# (`Foo 1, `Foo "abc");;
- : [> `Foo of int ] * [> `Foo of string ] = (`Foo 1, `Foo "abc")

また、ヴァリアントと同様にパターンマッチングでも多相ヴァリアントを使用することができます。次の例を見てください。

リスト 6 : 合計値を求める

let rec sum_of_number ?(a=0) ?(b=0.0) = function
  [] -> (a, b)
| `Int x :: xs -> sum_of_number ~a:(a + x) ~b xs
| `Float x :: xs -> sum_of_number ~a ~b:(b +. x) xs

関数 sum_of_number は整数と実数の合計を求め、組 (int * float) にして返します。`Int が整数を表し、`Float が実数を表します。オプション引数 a, b を累積変数として使い、a に整数の合計値、b に実数の合計値を求めます。`Int x :: xs と `Float x :: xs がパターンです。リストの先頭の要素が `Int の場合、2 番目の定義とマッチングして、x の値は整数になります。要素が `Float の場合は 3 番目の定義とマッチングして、x の値は実数になります。

実際に sum_of_number を定義すると、データ型は次のように表示されます。

val sum_of_number :
  ?a:int ->
  ?b:float -> [< `Float of float | `Int of int ] list -> int * float = <fun>

簡単な実行例を示します。

# sum_of_number [`Int 1; `Int 2; `Float 1.2; `Int 3; `Float 4.5];;
- : int * float = (6, 5.7)

●多相ヴァリアントのデータ型

それでは、[> ...] と [< ...] の違いについて説明します。[> ...] で表されるデータ型は、角カッコの中のコンストラクタだけではなく、他の任意のコンストラクタを含めることができます。次の例を見てください。

# let a = [`A];;
val a : [> `A ] list = [`A]
# let b = `B :: a;;
val b : [> `A | `B ] list = [`B; `A]
# let c = `C :: b;;
val c : [> `A | `B | `C ] list = [`C; `B; `A]
# `A 10 :: a;;
Characters 9-10:
  `A 10 :: a;;
           ^
This expression has type [> `A ] list but is here used with type
  [> `A of int ] list
Types for tag `A are incompatible

`A をリストに格納すると、そのデータ型は [> `A] list になります。データ型は [> ...] なので、このリストに任意の多相ヴァリアントのコンストラクタを追加することができます。`B を追加すると型は [> `A | `B ] list になり、さらに `C を追加すると [> `A | `B | `C ] list になります。

ただし、角カッコの中のコンストラクタは、そのデータ型しか受け付けません。たとえば [> `A] list の場合、`A を追加することはできますが、`A 10 のように異なるデータ型 (`A of int) を追加することはできません。つまり、角カッコの中でコンストラクタのデータ型を制限しているわけです。

また、データ型を [ `A ] list に指定すると、要素が `A のリストになり、[ `A | `B ] list であれば、要素が `A または `B のリストになります。この場合、他のコンストラクタを追加することはできません。簡単な例を示します。

# let a = ([`A]: [`A] list);;
val a : [ `A ] list = [`A]
# `A :: a;;
- : [ `A ] list = [`A; `A]
# `B :: a;;
Characters 6-7:
  `B :: a;;
        ^
This expression has type [ `A ] list but is here used with type [> `B ] list
The first variant type does not allow tag(s) `B

これに対して、[< ...] が表すデータ型は、角カッコの中に定義されているコンストラクタからなるデータ型を表します。たとえば、[< `A | `B ] はデータ型が [ `A ] でも [ `B ] でも [ `A | `B ] でも受け付けます。他のデータ型は受け付けません。

簡単な例を示しましょう。リストに格納された `A と `B の個数を返す関数 foo を作ります。

リスト 7 : `A と `B の個数を求める (1)

let rec foo ?(a=0) ?(b=0) ls =
  match ls with
    [] -> (a, b)
  | `A :: xs -> foo ~a:(a + 1) ~b xs
  | `B :: xs -> foo ~a ~b:(b + 1) xs

foo を定義すると、データ型は次のように表示されます。

val foo ; ?a:int -> ?b:int -> [< `A | `B ] list -> int * int = <fun>

リストのデータ型は [< `A | `B ] list なので、 [ `A ] list でも [ `B ] list でも [ `A | `B ] list でも受け付けます。次の例を見てください。

# let a = ([`A; `A; `A]: [`A] list);;
val a : [ `A ] list = [`A; `A; `A]
# let b = ([`B; `B; `B]: [`B] list);;
val b : [ `B ] list = [`B; `B; `B]
# let c = ([`A; `B; `A]: [`A | `B] list);;
val c : [ `A | `B ] list = [`A; `B; `A]

# foo a;;
- : int * int = (3, 0)
# foo b;;
- : int * int = (0, 3)
# foo c;;
- : int * int = (2, 1)

変数 a には [`A] list、b には [`B] list、c には [`A | `B] list をセットします。これらのリストはデータ型を規定していることに注意してください。それでも、これらのリストを foo に渡すと `A と `B の個数を求めることができます。

もしも、次のように foo の引数のデータ型を規定すると、そのデータ型しか渡すことができません。

リスト 8 : `A と `B の個数を求める (2)

let rec foo1 ?(a=0) ?(b=0) (ls: [`A | `B] list) =
  match ls with
    [] -> (a, b)
  | `A :: xs -> foo1 ~a:(a + 1) ~b xs
  | `B :: xs -> foo1 ~a ~b:(b + 1) xs

foo1 を定義すると、データ型は次のように表示されます。

val foo1 ; ?a:int -> ?b:int -> [ `A | `B ] list -> int * int = <fun>

この場合、[`A] list や [`B] list を渡すとエラーになります。ただし、リストの型が [> `A ] list や [> `B ] list であれば、foo1 に渡すことができます。

# let a1 = [`A; `A; `A];;
val a1 : [> `A ] list = [`A; `A; `A]
# foo1 a1;;
- : int * int = (3, 0)
# let b1 = [`B; `B; `B];;
val b1 : [> `B ] list = [`B; `B; `B]
# foo1 b1;;
- : int * int = (0, 3)

今度は `A, `B 以外のコンストラクタも数える関数 bar を作りましょう。次のリストを見てください。

リスト 9 : `A と `B とその他のコンストラクタの個数を求める

let rec bar ?(a=0) ?(b=0) ?(c=0) ls =
  match ls with
    [] -> (a, b, c)
  | `A :: xs -> bar ~a:(a + 1) ~b ~c xs
  | `B :: xs -> bar ~a ~b:(b + 1) ~c xs
  | _ :: xs -> bar ~a ~b ~c:(c + 1) xs

bar を定義すると、データ型は次のように表示されます。

val bar : ?a:int -> ?b:int -> ?c:int ->
          [> `A | `B ] list -> int * int * int = <fun>

引数の型が [> `A | `B ] list に変わっていることに注意してください。bar は `A, `B 以外のコンストラクタも受け付けるので、データ型が [< ...] から [> ...] になるのです。簡単な実行例を示しましょう。

# bar a1;;
- : int * int * int = (3, 0, 0)
# bar b1;;
- : int * int * int = (0, 3, 0)
# bar c;;
- : int * int * int = (2, 1, 0)
# let d = ([`A; `B; `C]: [`A | `B| `C]);;
val d : [`A | `B | `C] list = [`A; `B; `C]
# bar d;;
- : int * int * int = (1, 1, 1)

データ型が [> `A | `B ] なので、[`A] list や [`B] list を bar に渡すとエラーになります。ただし、[> `A] list や [> `B] list は大丈夫です。また、[`A | `B] list や [`A | `B | `C] list も渡すことができます。

●関数定義の拡張

多相ヴァリアントを使うと、関数定義を変更せずに機能を拡張できる場合があります。たとえば、多相ヴァリアントで図形の面積を求める関数 area を作ってみましょう。次のリストを見てください。

リスト 10 : 図形の面積を求める

let pi = 3.14159265

(* 面積を求める *)
let area = function
  `Circle r -> r *. r *. pi
| `Triangle (a, b) -> a *. b /. 2.0
| `Rectangle (w, h) -> w *. h

`Circle が円、`Triangle が三角形、`Rectangle が長方形を表します。area を定義すると、型は次のように表示されます。

val area :
  [< `Circle of float
   | `Rectangle of float * float
   | `Triangle of float * float ] ->
  float = <fun>

実行例を示します。

# area (`Circle 10.0);;
- : float = 314.159265
# area (`Triangle (10.0, 10.0));;
- : float = 50.
# area (`Rectangle (10.0, 10.0));;
- : float = 100.

次は、この area に新しい図形 `Square (正方形) を追加することを考えます。多相ヴァリアントを使うと、area を修正しなくても新しい図形を追加することができます。次のリストを見てください。

リスト 11 : 図形の面積を求める (2)

type figure = 
  [ `Circle of float |
    `Triangle of float * float |
    `Rectangle of float * float ]

let area = function
  `Square edge -> edge *. edge
| #figure as x -> area x

新しい関数 area を定義し、そこから元の関数 area を呼び出します。たとえば、対話モードでプログラムを読み込むと、変数や関数の定義は対話モードの環境に追加されます。対話モードの環境を「トップレベルの環境」といいます。トップレベルの環境には、あらかじめ定義されている関数や変数があます。変数や関数を環境に追加するとき、同じ名前が存在している場合はどうなるのでしょうか。次の例を見てください。

# let a = 10;;
val a : int = 10
# a;;
- : int = 10
# let a = "foo";;
val a : string = "foo"
# a;;
- : string = "foo"

let による変数の定義は、変数束縛を生成して環境に追加するだけです。変数束縛を変数名と値の組で、環境を連想リストで表すとわかりやすいと思います。最初、環境は空リストとします。次の図を見てください。

                    環境
---------------------------------------
                  [ ]
let a = 10    ==> [(a, 10)]
let a = "foo" ==> [(a, "foo"); (a, 10)]

    図 1 : トップレベルの環境

let a = 10 は変数束縛 (a, 10) を生成して環境に追加します。環境は [ (a, 10) ] になります。環境から値を求める場合は、連想リストの探索と同じです。連想リストの先頭から変数 a を探し、最初に見つけた変数束縛の値を返します。この場合、変数 a の値は 10 になります。

次の let a = "foo" も同様に、(a, "foo") を生成して環境に追加します。このとき、連想リストの先頭に追加するので、環境は [ (a, "foo"); (a, 10) ] になります。変数 a の値を求めると、最初に見つかる変数束縛は (a, "foo") なので、変数 a の値は "foo" になります。

結果だけを見ると、変数 a の値を書き換えているように見えますが、実際は新しい変数束縛を生成して環境に追加しているだけなのです。環境には前の変数束縛も残っています。しかしながら、追加した変数束縛によって隠されてしまうので、前の変数束縛にアクセスすることはできません。

これは関数定義の場合も同じです。新しい area を定義する場合、古い area が書き換えられることはありません。新しい area は再帰関数ではないので、その中で関数 area を呼び出すと、古い area の定義を呼び出すことになります。そして、新しい area が定義されると変数束縛が追加されるので、対話モードや他の関数から area を呼び出すと、新しい関数 area の定義を呼び出すことになるわけです。

元の関数を呼び出すとき、`Circle, `Triangle, `Rectangle とマッチするパターンを記述する必要があります。このとき、OR パターンでプログラムしてもいいのですが、type で型を宣言して、その名前の前に # を付けると簡単です。type で型 figure を宣言すると、`Circle, `Triangle, `Rectangle は #figure でパターンマッチングすることができます。

実際に、figure と area を定義すると、型は次のように表示されます。

type figure =
    [ `Circle of float
    | `Rectangle of float * float
    | `Triangle of float * float ]
val area :
  [< `Circle of float
   | `Rectangle of float * float
   | `Square of float
   | `Triangle of float * float ] ->
  float = <fun>

それでは、`Square の実行例を示します。

# area (`Square 10.);;
- : float = 100.

同様に、新しい図形 `Trapezoid (台形) を追加することができます。次のリストを見てください。

リスト 12 : 図形の面積を求める (3)

type figure1 = [ figure | `Square of float ]

let area = function
  `Trapezoid (a, b, h) -> (a +. b) *. h /. 2.0
| #figure1 as x -> area x

figure に `Square of float を追加するだけで新しい型 figure1 を定義することができます。あとは、`Trapezoid の処理を追加するだけです。実際に figure1 と area を定義すると、型は次のように表示されます。

type figure1 =
    [ `Circle of float
    | `Rectangle of float * float
    | `Square of float
    | `Triangle of float * float ]
val area :
  [< `Circle of float
   | `Rectangle of float * float
   | `Square of float
   | `Trapezoid of float * float * float
   | `Triangle of float * float ] ->
  float = <fun>

実行例を示しましょう。

# area (`Trapezoid (1., 2., 3.));;
- : float = 4.5

このほかにも、多相ヴァリアントは再帰的なデータ構造も定義できますし、より高度な使い方も可能です。ただし、正直にいいますが、多相ヴァリアントのデータ型は複雑で、M.Hiroi のような初心者が使いこなすにはちょっと難しいですね。今後の課題にしたいと思います。

●問題

多相ヴァリアント `NIL と `Cons を使うと、連結リスト 'a vlist は次のように定義することができます。

type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]

連結リスト ('a vlist) の操作関数を定義してください。

  1. xs の先頭要素を取り出す関数 head xs
  2. xs から先頭要素を取り除く関数 tail xs
  3. xs の長さを求める関数 length xs
  4. xs を反転する関数 reverse xs
  5. xs と ys を連結する関数 append xs ys
  6. マッピングを行う関数 map f xs
  7. フィルタリングを行う関数 filter pred xs
  8. xs の先頭から畳み込みを行う関数 fold_left f a xs
  9. xs の末尾から畳み込みを行う関数 flod_right f a xs
  10. xs を巡回する関数 iter f xs












●解答

リスト : 多相ヴァリアントによる連結リストの実装

(* 例外 *)
exception Empty

(* 連結リストの定義 *)
type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]

(* リスト操作関数 *)
let head = function
    `Nil -> raise Empty
  | `Cons(x, _) -> x

let tail = function
    `Nil -> raise Empty
  | `Cons(_, xs) -> xs

let rec length ?(c = 0) = function
    `Nil -> c
  | `Cons(_, xs) -> length ~c:(c + 1) xs

let rec append xs ys =
  match xs with
    `Nil -> ys
  | `Cons(x, xs1) -> `Cons(x, append xs1 ys)

let rec reverse ?(a = `Nil) = function
    `Nil -> a
  | `Cons(x, xs) -> reverse ~a:(`Cons(x, a)) xs

(* 高階関数 *)
let rec map f = function
    `Nil -> `Nil
  | `Cons(x, xs) -> `Cons(f x, map f xs)

let rec filter pred = function
    `Nil -> `Nil
  | `Cons(x, xs) -> if pred x then `Cons(x, filter pred xs)
                    else filter pred xs

let rec fold_left f a = function
    `Nil -> a
  | `Cons(x, xs) -> fold_left f (f a x) xs

let rec fold_right f a = function
    `Nil -> a
  | `Cons(x, xs) -> f x (fold_right f a xs)

let rec iter f = function
    `Nil -> ()
  | `Cons(x, xs) -> f x; iter f xs
exception Empty
type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
val cons : 'a -> 'b -> [> `Cons of 'a * 'b ] = <fun>
val head : [< `Cons of 'a * 'b | `Nil ] -> 'a = <fun>
val tail : [< `Cons of 'a * 'b | `Nil ] -> 'b = <fun>
val length : ?c:int -> ([< `Cons of 'b * 'a | `Nil ] as 'a) -> int = <fun>
val append :
  ([< `Cons of 'b * 'a | `Nil ] as 'a) -> ([> `Cons of 'b * 'c ] as 'c) -> 'c = <fun>
val reverse :
  ?a:([> `Cons of 'b * 'a | `Nil ] as 'a) ->
  ([< `Cons of 'b * 'c | `Nil ] as 'c) -> 'a = <fun>
val map :
  ('a -> 'b) ->
  ([< `Cons of 'a * 'c | `Nil ] as 'c) ->
  ([> `Cons of 'b * 'd | `Nil ] as 'd) = <fun>
val filter :
  ('a -> bool) ->
  ([< `Cons of 'a * 'b | `Nil ] as 'b) ->
  ([> `Cons of 'a * 'c | `Nil ] as 'c) = <fun>
val fold_left :
  ('a -> 'b -> 'a) -> 'a -> ([< `Cons of 'b * 'c | `Nil ] as 'c) -> 'a = <fun>
val fold_right :
  ('a -> 'b -> 'b) -> 'b -> ([< `Cons of 'a * 'c | `Nil ] as 'c) -> 'b = <fun>
val iter : ('a -> 'b) -> ([< `Cons of 'a * 'c | `Nil ] as 'c) -> unit = <fun>

簡単な実行例を示します。

# let a = `Cons(1, `Cons(2, `Cons(3, `Nil)));;
val a : [> `Cons of int * [> `Cons of int * [> `Cons of int * [> `Nil ] ] ] ] =
  `Cons (1, `Cons (2, `Cons (3, `Nil)))

# head a;;
- : int = 1

# tail a;;
- : [> `Cons of int * [> `Cons of int * [> `Nil ] ] ] =
`Cons (2, `Cons (3, `Nil))

# length a;;
- : int = 3

# append a a;;
- : [> `Cons of int * 'a | `Nil ] as 'a =
`Cons (1, `Cons (2, `Cons (3, `Cons (1, `Cons (2, `Cons (3, `Nil))))))

# reverse a;;
- : [> `Cons of int * 'a | `Nil ] as 'a =
`Cons (3, `Cons (2, `Cons (1, `Nil)))

# map (fun x -> x * x) a;;
- : [> `Cons of int * 'a | `Nil ] as 'a =
`Cons (1, `Cons (4, `Cons (9, `Nil)))

# filter (fun x -> x mod 2 <> 0) a;;
- : [> `Cons of int * 'a | `Nil ] as 'a = `Cons (1, `Cons (3, `Nil))

# fold_left (+) 0 a;;
- : int = 6
# fold_left (fun a x -> `Cons(x, a)) `Nil a;;
- : [> `Cons of int * 'a | `Nil ] as 'a =
`Cons (3, `Cons (2, `Cons (1, `Nil)))

# fold_right (+) 0 a;;
- : int = 6
# fold_right (fun x a -> `Cons(x, a)) `Nil a;;
- : [> `Cons of int * 'a | `Nil ] as 'a =
`Cons (1, `Cons (2, `Cons (3, `Nil)))

# iter (fun x -> print_int x; print_newline()) a;;
1
2
3
- : unit = ()

初版 2008 年 8 月 17 日
改訂 2020 年 7 月 26 日