《プログラミングの基礎》をReScriptで読む 第20章

《プログラミングの基礎》はとても良い本です。
サンプルプログラムをReScriptで書いて、プログラミングの基礎とReScriptを学びます。

環境

• macOS Sonoma(バージョン 14.4.1)
• ReScript 11.1.0-rc.8
• @rescript/core 1.2.0

第20章

Edgeの情報を保持するデータ構造を二分木から赤黒木に変えます。

Ex20_1.res

// 赤か黒を示す型
type color_t = Red | Black

// 木を表す型
type rec rb_tree_t<'a, 'b> =
  Empty
| Node(rb_tree_t<'a, 'b>, 'a, 'b, color_t, rb_tree_t<'a, 'b>)

Ex20_2.res

open Ex20_1 // colot_t, rb_tree_t の定義
 
// 目的：赤黒木の赤の連続を解消する
// balance : ('a, 'b) rb_tree_t -> ('a, 'b) rb_tree_t
let balance = (rb_tree) => switch rb_tree {
| Node(Node(Node(a, xa, xb, Red, b), ya, yb, Red, c), za, zb, Black, d) 
| Node(Node(a, xa, xb, Red, Node(b, ya, yb, Red, c)), za, zb, Black, d) 
| Node(a, xa, xb, Black, Node(Node(b, ya, yb, Red, c), za, zb, Red, d)) 
| Node(a, xa, xb, Black, Node(b, ya, yb, Red, Node(c, za, zb, Red, d)))
 => Node(Node(a, xa, xb, Black, b), ya, yb, Red, Node(c, za, zb, Black, d))
| _ => rb_tree 
}

// テスト
let rb_tree1 = 
  Node(Node(Node(Empty, 10, "x", Red, Empty), 13, "y", Red, Empty), 
	15, "z", Black, Empty) 
let rb_tree2 = 
  Node(Node(Empty, 10, "x", Red, Node(Empty, 13, "y", Red, Empty)), 
	15, "z", Black, Empty) 
let rb_tree3 = 
  Node(Empty, 10, "x", Black, 
	Node(Node(Empty, 13, "y", Red, Empty), 15, "z", Red, Empty)) 
let rb_tree4 = 
  Node(Empty, 10, "x", Black, 
	Node(Empty, 13, "y", Red, Node(Empty, 15, "z", Red, Empty))) 
let rb_tree5 = 
  Node(Node (Empty, 10, "x", Black, Empty), 13, "y", Red, 
	Node(Empty, 15, "z", Black, Empty)) 
let rb_tree6 = Empty
Console.log(balance(rb_tree1) == rb_tree5)
Console.log(balance(rb_tree2) == rb_tree5)
Console.log(balance(rb_tree3) == rb_tree5)
Console.log(balance(rb_tree4) == rb_tree5)
Console.log(balance(rb_tree6) == rb_tree6)

Ex20_3.res

open Ex20_1 // colot_t, rb_tree_t の定義
open Ex20_2 // balance の定義

// 目的：赤黒木とキーと値を受け取ったら、それを挿入した赤黒木を返す
// insert : ('a, 'b) rb_tree_t -> 'a -> 'b -> ('a, 'b) rb_tree_t *) 
let insert = (rb_tree, k, v) => {
  let rec ins = (rb_tree) => switch rb_tree { 
  | Empty => Node(Empty, k, v, Red, Empty)
  | Node(left, key, value, color, right) =>
      if k == key {Node(left, k, v, color, right)}
      else if k < key {balance(Node(ins(left), key, value, color, right))}
      else {balance(Node(left, key, value, color, ins(right)))}
  }
  switch ins(rb_tree) {
  | Empty => assert false // 絶対に空ではない
  | Node(left, key, value, _, right) => Node (left, key, value, Black, right) 
  }
}

// テスト
let rb_tree0 = Empty 
let rb_tree1 = insert(rb_tree0, 10, "x")
let rb_tree2 = insert(rb_tree1,13, "y")
let rb_tree3 = insert(rb_tree2, 15, "z")
 
Console.log(rb_tree1 == Node(Empty, 10, "x", Black, Empty))
Console.log(rb_tree2 == Node(Empty, 10, "x", Black, 
			     Node(Empty, 13, "y", Red, Empty)))
Console.log(rb_tree3 == Node(Node(Empty, 10, "x", Black, Empty),
			     13, "y", Black,
			     Node(Empty, 15, "z", Black, Empty)))


// 目的: 赤黒木とキーと値を受け取ったら、それを挿入した赤黒木を返す
// insert : ('a, 'b) rb_tree_t -> 'a -> 'b -> ('a, 'b) rb_tree_t
let tree_a = insert(Empty, 1, "a")
Console.log(tree_a == Node(Empty, 1, "a", Black, Empty))
let node_b = insert(tree_a, 3, "b")
Console.log(node_b == Node(Empty, 1, "a", Black, Node(Empty, 3, "b", Red, Empty)))

Ex20_4.res

open Ex20_1 //rb_tree_t

// 目的：赤黒木とキーを受け取ったら、そのキーに対応する値を返す
// search : ('a, 'b) rb_tree_t -> 'a -> 'b
let rec search = (rb_tree, k) => switch rb_tree {
| Empty => raise(Not_found)
| Node(left, key, value, _, right) =>
    if k == key {value}
    else if k < key {search(left, k)}
    else {search(right, k)}
}

// テスト
let rb_tree = 
  Node(Node(Empty, 10, "x", Black, Empty), 13, "y", Red, 
	Node(Empty, 15, "z", Black, Empty)) 
Console.log(search(rb_tree, 10) == "x")
Console.log(search(rb_tree, 13) == "y")
Console.log(search(rb_tree, 15) == "z")
// Console.log(search(rb_tree, 17))
  // Not_found を起こす 

RedBlack.resi

// 赤黒木を表すモジュールのシグネチャ（２分木のモジュールと同一）

type t<'a, 'b>
  // キーが 'a 型、値が 'b 型の木の型。型の中身は非公開

let empty : t<'a, 'b>
  // 使い方：empty
  // 空の木

let insert : (t<'a, 'b>, 'a, 'b) => t<'a, 'b>
  // 使い方：insert tree key value
  // 木 tree にキー key と値 value を挿入した木を返す
  // キーが既に存在していたら新しい値に置き換える

let search : (t<'a, 'b>, 'a) => 'b 
  // 使い方：search tree key
  // 木 tree の中からキー key に対応する値を探して返す
  // みつからなければ Not_found を raise する

let traverse : ((('a, 'b, 'c) => 'a), 'a, t<'b, 'c>) => 'a 
  // 使い方：traverse f init tree
  // 全てのノードを深さ優先で訪れる
  // 初期値 init から始めて、各ノードで関数 f を順に適用する

let length : t<'a, 'b> => int 
  // 使い方：length tree
  // 木の中にあるノードの数を求める 

RedBlack.res

// 赤か黒を示す型
type color_t = Red | Black 
 
// 木を表す型
type rec t<'a, 'b> = 
    Empty 
  | Node(t<'a, 'b>, 'a, 'b, color_t, t<'a, 'b>)

// 空の赤黒木
let empty = Empty 
 
// 目的：赤黒木の赤の連続を解消する
// balance : ('a, 'b) t -> ('a, 'b) t
let balance = (rb_tree) => switch rb_tree {
| Node(Node(Node(a, xa, xb, Red, b), ya, yb, Red, c), za, zb, Black, d)
| Node(Node(a, xa, xb, Red, Node(b, ya, yb, Red, c)), za, zb, Black, d)
| Node(a, xa, xb, Black, Node(Node(b, ya, yb, Red, c), za, zb, Red, d))
| Node(a, xa, xb, Black, Node(b, ya, yb, Red, Node(c, za, zb, Red, d)))
 => Node(Node(a, xa, xb, Black, b), ya, yb, Red, Node(c, za, zb, Black, d))
| _ => rb_tree 
}

// 目的：赤黒木とキーと値を受け取ったら、それを挿入した赤黒木を返す
// insert : ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t
let insert = (rb_tree, k, v) => {
  let rec ins = (rb_tree) => switch rb_tree {
  | Empty => Node(Empty, k, v, Red, Empty)
  | Node(left, key, value, color, right) =>
      if k == key {Node(left, k, v, color, right)}
      else if k < key {balance(Node(ins(left), key, value, color, right))}
      else {balance(Node(left, key, value, color, ins(right)))}
  }
  switch ins(rb_tree) {
  | Empty => assert false // 絶対に空ではない
  | Node(left, key, value, _, right) => 
      Node (left, key, value, Black, right) 
  }
}

// 目的：赤黒木とキーを受け取ったら、そのキーに対応する値を返す
// search : ('a, 'b) t -> 'a -> 'b
let rec search = (rb_tree, k) => switch rb_tree { 
| Empty => raise(Not_found)
| Node(left, key, value, _, right) =>
    if k == key {value}
    else if k < key {search(left, k)}
    else {search(right, k)}
}

// 目的：全てのノードを深さ優先で訪れる
// 初期値 init から始めて、各ノードで関数 f を順に適用する
// Ex23_3.res で使用
// traverse : ('a -> 'b -> 'c -> 'a) -> 'a -> ('b, 'c) t -> 'a
let rec traverse = (f, init, tree) => switch tree {
| Empty => init
| Node(left, key, value, _, right) => {
    let result1 = f(init, key, value)
    let result2 = traverse(f, result1, left)
    let result3 = traverse(f, result2, right)
    result3 
  }
}

// 目的：木の中にあるノードの数を求める
// Ex23_3.res で使用
// length : ('a, 'b) t -> int
let rec length = (tree) => switch tree {
| Empty => 0
| Node(left, _, _, _, right) =>
    length(left) + 1 + length(right)
}

Ex20_5.res

open Ex08_5   //ekikan_t の定義
open Ex08_7   //ekikan_tree_t の定義
open Ex09_9   //ekimei_t の定義
open Ex09_10  //global_ekikan_list の定義
open Ex12_1   //eki_t の定義
open Ex17_11  //assoc の定義
open Ex17_16  //saitan_wo_bunri の定義
open Ex18_7   //romaji_to_kanji の定義

// 目的：受け取った kiten, shuten, kyori を ekikan_tree に挿入した木を返す
// insert1 : (string * (string * float) list) RedBlack.t ->
// 	      string -> string -> float ->
// 	     (string * (string * float) list) RedBlack.t
let insert1 = (ekikan_tree, kiten, shuten, kyori) => {
  let lst = try {
	  RedBlack.search(ekikan_tree, kiten)
	} catch {
  | Not_found => list{}
  }
  RedBlack.insert(ekikan_tree, kiten, list{(shuten, kyori), ...lst})
}

// 目的：受け取った ekikan 情報を ekikan_tree に挿入した木を返す
// insert_ekikan : (string * (string * float) list) RedBlack.t ->
//		    ekikan_t ->
//		   (string * (string * float) list) RedBlack.t
let insert_ekikan = (ekikan_tree, ekikan) => switch ekikan {
| {kiten: k, shuten: s, keiyu: _, kyori: r, jikan: _} =>
    insert1((insert1(ekikan_tree, s, k, r)), k, s, r)
}

// 目的：受け取った ekikan のリストを ekikan_tree に挿入した木を返す
// inserts_ekikan : (string * (string * float) list) RedBlack.t -> 
//		     ekikan_t list ->
//		    (string * (string * float) list) RedBlack.t
let inserts_ekikan = (ekikan_tree, ekikan_list) =>
  Js.List.foldLeft(insert_ekikan, ekikan_tree, ekikan_list)

// 目的：ふたつの駅の間の距離を求める
// 見つからなかったら例外 Not_found を起こす
// get_ekikan_kyori : string -> string -> 
//		     (string * (string * float) list) RedBlack.t -> float *) 
let get_ekikan_kyori = (eki1, eki2, tree) =>
  assoc(eki2, (RedBlack.search(tree, eki1)))

// 目的：ekimei list から eki list を作る
// make_initial_eki_list : ekimei_t list -> string -> eki_t list *) 
let make_initial_eki_list = (ekimei_list, kiten) =>
  List.map(
	  ekimei_list,
    (ekimei) => switch ekimei { 
	  | {kanji: k, kana: _, romaji: _, shozoku: _} =>
	    if k == kiten {{namae: k, saitan_kyori: 0., temae_list: list{k}}}
	    else {{namae: k, saitan_kyori: Float.Constants.positiveInfinity, temae_list: list{}}}
    }
  )

// 目的：未確定の駅のリスト v を必要に応じて更新したリストを返す
// koushin : eki_t -> eki_t list -> ekikan_tree_t -> eki_t list
let koushin = (p, v, ekikan_tree) => switch p {
| {namae: pn, saitan_kyori: ps, temae_list: pt} => 
    List.map (
      v,
      (q) => switch q {
	    | {namae: qn, saitan_kyori: qs, temae_list: _} =>
		  try {
		    let kyori = get_ekikan_kyori(pn, qn, ekikan_tree)
		    if ps +. kyori < qs {{namae: qn, saitan_kyori: ps +. kyori, temae_list: list{qn, ...pt}}}
		    else {q}
      } catch {
      | Not_found => q
      }
      }
    )
}

// 目的：未確定駅のリストと駅間リストから、各駅への最短路を求める
// dijkstra_main : eki_t list -> ekikan_tree_t -> eki_t list
let rec dijkstra_main = (eki_list, ekikan_tree) => switch eki_list {
| list{} => list{}
| list{first, ...rest} => {
    let (saitan, nokori) = saitan_wo_bunri(first, rest)
    let eki_list2 = koushin(saitan, nokori, ekikan_tree)
    list{saitan, ...dijkstra_main(eki_list2, ekikan_tree)}
  }
}

// 目的：受け取った eki_list から shuten のレコードを探し出す
// find : string -> eki_t list -> eki_t
let rec find = (shuten, eki_list) => switch eki_list {
| list{} => {namae: "", saitan_kyori: Float.Constants.positiveInfinity, temae_list: list{}}
| list{{namae: n, saitan_kyori: s, temae_list: t}, ...rest} =>
    if n == shuten {{namae: n, saitan_kyori: s, temae_list: t}}
    else {find(shuten, rest)}
}

// 目的：始点と終点を受け取ったら、最短路を求め、終点のレコードを返す
// dijkstra : string -> string -> eki_t
let dijkstra = (romaji_kiten, romaji_shuten) => {
  let kiten = romaji_to_kanji(romaji_kiten, global_ekimei_list)
  let shuten = romaji_to_kanji(romaji_shuten, global_ekimei_list)
  let eki_list = make_initial_eki_list(global_ekimei_list, kiten)
  let global_ekikan_tree = inserts_ekikan(RedBlack.empty, global_ekikan_list)
  let eki_list2 = dijkstra_main(eki_list, global_ekikan_tree)
  find(shuten, eki_list2)
}

// テスト
let test1 = dijkstra("shibuya", "gokokuji") == 
  {namae: "護国寺", saitan_kyori: 9.8, 
    temae_list: 
      list{"護国寺", "江戸川橋", "飯田橋", "市ヶ谷", "麹町", "永田町",
        "青山一丁目", "表参道", "渋谷"}}
let test2 = dijkstra("myogadani", "meguro") ==
  {namae: "目黒", saitan_kyori: 12.7000000000000028,
   temae_list: 
     list{"目黒", "白金台", "白金高輪", "麻布十番", "六本木一丁目", "溜池山王",
      "永田町", "麹町", "市ヶ谷", "飯田橋", "後楽園", "茗荷谷"}} 

Ex20_6.res

open Ex08_5   //ekimei_t の定義
open Ex08_7   //ekikan_t の定義
open Ex09_9   //ekimei_t の定義
open Ex09_10  //ekikan_t, global_ekikan_list の定義
open Ex12_1   //eki_t の定義
open Ex17_11  //assoc の定義
open Ex17_16  //saitan_wo_bunri の定義
open Ex18_7   //romaji_to_kanji の定義

open RedBlack

// 目的：受け取った kiten, shuten, kyori を ekikan_tree に挿入した木を返す
// insert1 : (string * (string * float) list) t ->
// 	      string -> string -> float ->
// 	     (string * (string * float) list) t
let insert1 = (ekikan_tree, kiten, shuten, kyori) => {
  let lst = try {
	  search(ekikan_tree, kiten)
	} catch {
  | Not_found => list{}
  }
  insert(ekikan_tree, kiten, list{(shuten, kyori), ...lst})
}

// 目的：受け取った ekikan 情報を ekikan_tree に挿入した木を返す
// insert_ekikan : (string * (string * float) list) t ->
//		    ekikan_t ->
//		   (string * (string * float) list) t
let insert_ekikan = (ekikan_tree, ekikan) => switch ekikan {
| {kiten: k, shuten: s, keiyu: _, kyori: r, jikan: _} =>
    insert1((insert1(ekikan_tree, s, k, r)), k, s, r)
}

// 目的：受け取った ekikan のリストを ekikan_tree に挿入した木を返す
// inserts_ekikan : (string * (string * float) list) t -> 
//		     ekikan_t list ->
//		    (string * (string * float) list) t
let inserts_ekikan = (ekikan_tree, ekikan_list) =>
  Js.List.foldLeft(insert_ekikan, ekikan_tree, ekikan_list)

// 目的：ふたつの駅の間の距離を求める
// 見つからなかったら例外 Not_found を起こす
// get_ekikan_kyori : string -> string -> 
//		     (string * (string * float) list) t -> float *) 
let get_ekikan_kyori = (eki1, eki2, tree) =>
  assoc(eki2, (search(tree, eki1)))

// 目的：ekimei list から eki list を作る
// make_initial_eki_list : ekimei_t list -> string -> eki_t list *) 
let make_initial_eki_list = (ekimei_list, kiten) =>
  List.map(
	  ekimei_list,
    (ekimei) => switch ekimei { 
	  | {kanji: k, kana: _, romaji: _, shozoku: _} =>
	    if k == kiten {{namae: k, saitan_kyori: 0., temae_list: list{k}}}
	    else {{namae: k, saitan_kyori: Float.Constants.positiveInfinity, temae_list: list{}}}
    }
  )

// 目的：未確定の駅のリスト v を必要に応じて更新したリストを返す
// koushin : eki_t -> eki_t list -> ekikan_tree_t -> eki_t list
let koushin = (p, v, ekikan_tree) => switch p {
| {namae: pn, saitan_kyori: ps, temae_list: pt} => 
    List.map (
      v,
      (q) => switch q {
	    | {namae: qn, saitan_kyori: qs, temae_list: _} =>
		  try {
		    let kyori = get_ekikan_kyori(pn, qn, ekikan_tree)
		    if ps +. kyori < qs {{namae: qn, saitan_kyori: ps +. kyori, temae_list: list{qn, ...pt}}}
		    else {q}
      } catch {
      | Not_found => q
      }
      }
    )
}

// 目的：未確定駅のリストと駅間リストから、各駅への最短路を求める
// dijkstra_main : eki_t list -> ekikan_tree_t -> eki_t list
let rec dijkstra_main = (eki_list, ekikan_tree) => switch eki_list {
| list{} => list{}
| list{first, ...rest} => {
    let (saitan, nokori) = saitan_wo_bunri(first, rest)
    let eki_list2 = koushin(saitan, nokori, ekikan_tree)
    list{saitan, ...dijkstra_main(eki_list2, ekikan_tree)}
  }
}

// 目的：受け取った eki_list から shuten のレコードを探し出す
// find : string -> eki_t list -> eki_t
let rec find = (shuten, eki_list) => switch eki_list {
| list{} => {namae: "", saitan_kyori: Float.Constants.positiveInfinity, temae_list: list{}}
| list{{namae: n, saitan_kyori: s, temae_list: t}, ...rest} =>
    if n == shuten {{namae: n, saitan_kyori: s, temae_list: t}}
    else {find(shuten, rest)}
}

// 目的：始点と終点を受け取ったら、最短路を求め、終点のレコードを返す
// dijkstra : string -> string -> eki_t
let dijkstra = (romaji_kiten, romaji_shuten) => {
  let kiten = romaji_to_kanji(romaji_kiten, global_ekimei_list)
  let shuten = romaji_to_kanji(romaji_shuten, global_ekimei_list)
  let eki_list = make_initial_eki_list(global_ekimei_list, kiten)
  let global_ekikan_tree = inserts_ekikan(RedBlack.empty, global_ekikan_list)
  let eki_list2 = dijkstra_main(eki_list, global_ekikan_tree)
  find(shuten, eki_list2)
}

// テスト
let test1 = dijkstra("shibuya", "gokokuji") == 
  {namae: "護国寺", saitan_kyori: 9.8, 
    temae_list: 
      list{"護国寺", "江戸川橋", "飯田橋", "市ヶ谷", "麹町", "永田町",
        "青山一丁目", "表参道", "渋谷"}}
let test2 = dijkstra("myogadani", "meguro") ==
  {namae: "目黒", saitan_kyori: 12.7000000000000028,
   temae_list: 
     list{"目黒", "白金台", "白金高輪", "麻布十番", "六本木一丁目", "溜池山王",
      "永田町", "麹町", "市ヶ谷", "飯田橋", "後楽園", "茗荷谷"}} 

Ex20_7.resi

// 集合を表すシグネチャ
type t<'a>
  // 要素の型が 'a の集合の型。型の中身は非公開

let empty : t<'a>
  // 使い方：empty
  // 空集合

let singleton : 'a => t<'a> 
  // 使い方：singleton element
  // 要素が element ひとつからなる集合を返す

let union : (t<'a>, t<'a>) => t<'a>
  // 使い方：union set1 set2
  // 集合 set1 と set2 の和集合を返す

let inter : (t<'a>, t<'a>) => t<'a>
  // 使い方：inter set1 set2
  // 集合 set1 と set2 の共通部分を返す

let diff : (t<'a>, t<'a>) => t<'a>
  // 使い方：diff set1 set2
  // 集合 set1 から set2 の要素を取り除いた集合（差集合）を返す

let mem : ('a, t<'a>) => bool 
  // 使い方：mem element set
  // 要素 element が集合 set に入っているかどうかを真偽値で返す

Ex20_7.res

// 集合のモジュール：リスト版
// 要素の型が 'a の集合の型。ここではリストを使っているが
// 木などを使うと以下の操作をより効率的に実現できるようになる
type t<'a> = list<'a>

// 空集合
// empty : 'a t
let empty = list{}

// 目的：要素が element ひとつからなる集合を返す
// singleton : 'a -> 'a t
let singleton = (element) => list{element}

// 目的：要素 element が集合 set に入っているかどうかを真偽値で返す
// mem : 'a -> 'a t -> bool
let mem = (element, set) => Js.List.foldRight(
  (first, rest_result) =>
    if first == element {true}
    else {rest_result},
  set,
  false
)
// let mem = (element, set) => List.has(set, element, (a, b) => a == b)

// 目的：集合 set1 と set2 の和集合を返す
// union : 'a t -> 'a t -> 'a t
let union = (set1, set2) => Js.List.foldRight(
  (first, rest_result) => 
    if mem(first, set2) {rest_result}
    else {list{first, ...rest_result}},
  set1,
  set2)

// 目的：集合 set1 と set2 の共通部分を返す
// inter : 'a t -> 'a t -> 'a t
let inter = (set1, set2) => Js.List.foldRight(
  (first, rest_result) => 
    if mem(first, set2) {list{first, ...rest_result}}
    else {rest_result},
  set1,
  list{}
)

// 目的：集合 set1 から set2 の要素を取り除いた集合（差集合）を返す
// diff : 'a t -> 'a t -> 'a t
let diff = (set1, set2) => Js.List.foldRight(
  (first, rest_result) => 
    if mem(first, set2) {rest_result}
    else {list{first, ...rest_result}},
  set1,
  list{}
)

let list1 = list{1, 2, 3}
let list2 = list{2, 3, 4}
Console.log(union(list1, list2) == list{1, 2, 3, 4})
Console.log(inter(list1, list2) == list{2, 3})
Console.log(diff(list1, list2) == list{1})