VList の実装（コメント欄に説明付き）

VList.ml

module type VLIST = sig
  type 'a t

  val nth: 'a t -> int -> 'a
  val length: 'a t -> int

  val cons: 'a -> 'a t -> 'a t
  val head: 'a t -> 'a
  val tail: 'a t -> 'a t

  val vlist_of_list: 'a list -> 'a t
  val list_of_vlist: 'a t -> 'a list
end



module VList: VLIST = struct
  (* memory block *)
  type 'a mb = { mutable base: 'a mb option; offset: int;
                 size: int; mutable last_used: int;
                 mBlock: 'a option array }

  type 'a t = { mutable base: 'a mb; offset: int }

  let ratio = 2

  let get: 'a option -> 'a = function
    | Some x -> x
    | None -> failwith "Tried to get from None"

  let rec nth_sup: int -> 'a mb -> 'a = fun n mb ->
    if n <= mb.offset then get (get mb.base).mBlock.(mb.offset - n)
    else nth_sup (n - (mb.offset + 1)) (get mb.base)

  let nth vl n =
    if n >= 0 then
      if n <= vl.offset then get vl.base.mBlock.(vl.offset - n)
      else nth_sup (n - (vl.offset + 1)) vl.base
    else
      failwith "index-number mustn't be negative-number"
                
  let rec length_sup: 'a mb -> int -> int = fun mb res ->
    match mb.base with
    | None -> res
    | Some pre_mb -> length_sup pre_mb (res + (mb.offset + 1))

  let length vl =
    let mb = vl.base in
    match mb.base with
    | None -> vl.offset + 1
    | Some _ -> length_sup mb (vl.offset + 1)

  let cons x vl =
    let mb = vl.base in
    if vl.offset == mb.last_used
    then  (* simply add to next index case *)
      if mb.last_used + 1 < mb.size
      then
        begin
          mb.mBlock.(vl.offset + 1) <- Some x;
          mb.last_used <- mb.last_used + 1;
          { base = vl.base; offset = vl.offset + 1 }
        end
      else
        let next_size = mb.size * ratio in
        let next_mb = { base = Some mb; offset = vl.offset;
                        size = next_size; last_used = 0;
                        mBlock = Array.make next_size None } in
        next_mb.mBlock.(0) <- Some x;
        { base = next_mb; offset = 0 }
    else   (* update case *)
      let next_mb = { base = Some mb; offset = vl.offset;
                      size = 1; last_used = 0;
                      mBlock = Array.make 1 None } in
      begin
        next_mb.mBlock.(0) <- Some x;
        { base = next_mb; offset = 0 }
      end

  let head vl = get vl.base.mBlock.(vl.offset)

  let tail vl =
    let mb = vl.base in
    match vl.offset with
    | 0 -> (
      match vl.base.base with
      | Some pre_mb -> { base = pre_mb; offset = mb.offset }
      | None -> { vl with offset = -1 })
    | i when i > 0 -> { vl with offset = vl.offset - 1 }
    | _ -> failwith "This list is empty"

  let vlist_of_list l =
    let fst_mb = { base = None; offset = 0;
                   size = 1; last_used = -1;
                   mBlock = Array.make 1 None } in
    let fst_pointer = { base = fst_mb; offset = -1 } in
    let rec make res = function
      | [] -> res
      | hd :: tl ->
        let mb = res.base in
        if res.offset + 1 < mb.size then
          begin
            mb.mBlock.(res.offset + 1) <- Some hd;
            mb.last_used <- mb.last_used + 1;
            make { res with offset = res.offset + 1 } tl
          end
        else
          let next_size = mb.size * ratio in
          let next_mb = { base = Some mb; offset = res.offset;
                          size = next_size; last_used = 0;
                          mBlock = Array.make next_size None } in
          begin
            next_mb.mBlock.(0) <- Some hd;
            make { base = next_mb; offset = 0 } tl
          end
    in make fst_pointer (List.rev l)

  let list_of_vlist vl =
    let rec make acc vl =
      let mb = vl.base in
      match (mb.base, vl.offset) with
      | (None, -1) -> List.rev acc
      | (None, _) -> List.rev @@ (head vl) :: acc
      | _ -> make (head vl :: acc) @@ tail vl
    in make [] vl
end

README

Overview

Fast Functional Lists, Hash-Lists, Deques and Variable Length Arrays, Phil Bagwell の VList の実装

Example

OCaml REPL にファイルを読み込み、VList をオープンします.

#use "VList.ml";;
open VList;;

vlist_of_list を使うことで、リストから VList を生成できます.

let l1 = vlist_of_list [8; 7; 6; 5; 4; 3];;

諸々コマンドを試してみましょう.

head l1;;
nth l1 3;;
length l1;;
list_of_vlist @@ tail l1;;

let l2 = cons 9 @@ tail (tail l1);;
list_of_vlist l2;;

ベンチマークっぽいやつ

要素数 n の Linked List と VList それぞれに対して全要素へのアクセスを行い, 速度を比べました.
実際に動かしてみると違いが良く分かると思います.

まず要素数25,000の Linked List と VList を作ります.

let n = 25000;;
let ll: int list = Array.to_list @@ Array.make n 42;;
let vl: int VList.t = vlist_of_list ll;;

Linked List の計測:

let start = Sys.time() in
for i = 0 to n - 1 do
  ignore @@ List.nth ll i
done;
Sys.time () -. start;;

-- 結果: 3.896 秒

VList の計測:

let start = Sys.time() in
for i = 0 to n - 1 do
  ignore @@ VList.nth vl i
done;
Sys.time () -. start;;

-- 結果: 0.004 秒

Linked List が O(n^2) 掛かるのに対して, VList は O(n) で済むためはるかに高速です.