プログラミング in OCaml メモ

参照を使ったデータ構造 – キュー

8.4 Case Study : 参照を使ったデータ構造 – キュー

ここの部分のコードを入力していくと、以下のようになる。

type 'a mlist = MNil | MCons of 'a * 'a mlist ref;;

type 'a queue = {mutable head : 'a mlist; mutable tail : 'a mlist};;

(* create -- 新しいキューをつくる = 空のキュー *)
let create () = {head = MNil; tail = MNil};;

実行例

let q : int queue = create ();;
q;;
- : int queue = {head = MNil; tail = MNil}
(* add -- 要素を加えるための関数 *)
let add a = function
    {head = MNil; tail = MNil} as q ->
        let c = MCons (a, ref MNil) in
        q.head <- c;
        q.tail <- c
    | {tail = MCons(_, next)} as q ->
            let c = MCons (a, ref MNil) in
            next := c;
            q.tail <- c
    | _ -> failwith "enqueue: input queue broken";;

実行例

add 1 q;;
q;;

- : int queue =
{head = MCons (1, {contents = MNil}); tail = MCons (1, {contents = MNil})}
(* peek -- 先頭要素を返す関数 *)
let peek = function
    {head = MNil; tail = MNil} -> failwith "ht: queue is empty"
  |{head = MCons(a, _)} -> a
  | _ -> failwith "hd: queue is broken";;

(* take -- 先頭要素を削除して、その先頭要素を返す関数 *)
let take = function
    {head = MNil; tail = MNil} ->failwith "dequeue: queue is empty"
  | {head = MCons(a, next)} as q -> q.head <= !next; a
  | _ -> failwith "dequeue: queue is broken";;

以下のようにすると、ちゃんと動いているようにみえる。

add 2 q; add 3 q;;
q;;
- : int queue =
{head = MCons (1, {contents = MCons (2, {contents = MCons (3, {contents = MNil})})});
 tail = MCons (3, {contents = MNil})}

take q;;
take q;;
add 4 q; take q;;
q;;
- : int queue =
{head = MCons (4, {contents = MNil}); tail = MCons (4, {contents = MNil})} 

ここで、以下のようにすると、エラーが出る。

ignore(take q); add 5 q; peek q;;  (* ここで、ignore はなくてもいける。 *)
Exception: Failure "hd: queue is broken".

テキストには、『これを修正するのは練習問題とします。』とあるので、考えてみた。

このとき、キューの状態は、以下である。

q;;
- : int queue = {head = MNil; tail = MCons (5, {contents = MNil})}

つまり、take で先頭の要素を削除したのだが、その結果、head が MNil となる、
つまり、キューの中の要素がなくなるのである。

だが、tail には、削除する前の要素が残っているので、不整合をおこしているのである。

take 関数では、先頭要素を削除したときに、まだ要素が残っている場合はいいのだが、
要素がなくなった場合、tail 要素にも MNil を代入する必要があるのである。

僕の考えた修正版 take は、以下である。

(* take -- 先頭要素を削除して、その先頭要素を返す関数 *)
let take = function
    {head = MNil; tail = MNil} ->failwith "dequeue: queue is empty"
  | {head = MCons(a, next)} as q ->
     if !next == MNil
     then (q.head <- !next; q.tail <- !next)
     else (q.head <- !next);
     a
  | _ -> failwith "dequeue: queue is broken";;

これで、キューに要素が1つしかないとき、take で要素を削除すると、キューは以下のようになる。

q;;
- : int queue =
{head = MCons (1, {contents = MNil}); tail = MCons (1, {contents = MNil})} 
take q;;
q;;
- : int queue = {head = MNil; tail = MNil}

ちゃんと、tail も MNil になっている。