package core-and-more

  1. Overview
  2. Docs
package core-and-more
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file my_tree.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
open Core
open Util
open Algebra
open My_list_extensions

type 'a nonempty_tree = Node of ('a * ('a nonempty_tree list))
[@@deriving ord, show, hash, eq]


type 'a tree =
  | NonemptyTree of 'a nonempty_tree
  | EmptyTree
[@@deriving ord, show, hash, eq]


type 'a nonempty_normalized_tree =
    NNode of ('a * ('a nonempty_normalized_tree list) * Permutation.t)
[@@deriving ord, show, hash, eq]

type 'a normalized_tree =
  | NonemptyNTree of 'a nonempty_normalized_tree
  | EmptyNTree
[@@deriving ord, show, hash, eq]

module TreeOf
    (D:Data)
  : Data with type t = D.t tree =
struct
  type t = D.t tree
  [@@deriving ord, show, hash, eq]
end


module UnorderedNonemptyTreeOf
    (D:Data)
  : Data with type t = D.t nonempty_tree =
struct
  type t = D.t nonempty_tree
  [@@deriving show, hash]

  let rec compare
      (Node n1:t)
      (Node n2:t)
    : int =
    pair_compare
      D.compare
      (ordered_partition_order compare)
      n1
      n2

  let equal
      (n1:t)
      (n2:t)
    : bool =
    is_equal (compare n1 n2)
end


module UnorderedTreeOf
    (D:Data) =
struct
  type t = D.t tree
  [@@deriving show, hash]

  type nonempty_t = D.t nonempty_tree

  let compare
      (t1:t)
      (t2:t)
    : int =
    let module NET = UnorderedNonemptyTreeOf(D) in
    begin match (t1,t2) with
      | (EmptyTree        , EmptyTree        ) -> 0
      | (EmptyTree        , NonemptyTree _   ) -> -1
      | (NonemptyTree _   , EmptyTree        ) -> 1
      | (NonemptyTree net1, NonemptyTree net2) ->
        NET.compare net1 net2
    end
end

module NonemptyNormalizedTreeOf
    (D:Data) =
struct
  type t = D.t nonempty_normalized_tree
  [@@deriving show, hash]

  let rec compare
      (NNode (l1,t1s,_):t)
      (NNode (l2,t2s,_):t)
    : int =
    pair_compare
      D.compare
      (compare_list ~cmp:compare)
      (l1,t1s)
      (l2,t2s)

  let rec from_nonempty_tree
      (Node (l,ts):UnorderedNonemptyTreeOf(D).t)
    : t =
    let normalized_ts = List.map ~f:from_nonempty_tree ts in
    let (p,sorted_normalized_ts) =
      sorting_and_sort
        ~cmp:compare
        normalized_ts
    in
    NNode (l,sorted_normalized_ts,p)
end

module NormalizedTreeOf
    (D:Data) =
struct
  type t = D.t normalized_tree
  [@@deriving show, hash]

  type nonempty_t = D.t nonempty_tree

  let compare
      (t1:t)
      (t2:t)
    : int =
    let module NENT = NonemptyNormalizedTreeOf(D) in
    begin match (t1,t2) with
      | (EmptyNTree         , EmptyNTree         ) -> 0
      | (EmptyNTree         , NonemptyNTree _    ) -> -1
      | (NonemptyNTree _    , EmptyNTree         ) -> 1
      | (NonemptyNTree nent1, NonemptyNTree nent2) ->
        NENT.compare nent1 nent2
    end

  let from_tree
      (t:UnorderedTreeOf(D).t)
    : t =
    let module NENT = NonemptyNormalizedTreeOf(D) in
    begin match t with
      | EmptyTree -> EmptyNTree
      | NonemptyTree n -> NonemptyNTree (NENT.from_nonempty_tree n)
    end
end