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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
(** *)
type name = [ `I of Iri.t | `B of Term.blank_id ]
let compare_name n1 n2 =
match n1, n2 with
| `I i1, `I i2 -> Iri.compare i1 i2
| `I _, _ -> 1
| _, `I _ -> -1
| `B id1, `B id2 -> String.compare
(Term.string_of_blank_id id1) (Term.string_of_blank_id id2)
let string_of_name name =
let term = match name with
| `I iri -> Term.Iri iri
| `B id -> Term.Blank_ id
in
Term.string_of_term term
let pp_name ppf name = Format.fprintf ppf "%s" (string_of_name name)
let term_of_name = function
| `I iri -> Term.Iri iri
| `B id -> Term.Blank_ id
module OrderedName = struct type t = name let compare = compare_name end
module NameMap = Map.Make(OrderedName)
module NameSet = Set.Make(OrderedName)
type dataset =
{ default : Graph.graph ;
named : unit -> NameSet.t ;
get_named : ?add:bool -> name -> Graph.graph option ;
add: (?name:name -> Graph.graph -> Graph.graph) option ;
}
let simple_dataset ?(named=[]) default =
let named_set = List.fold_left (fun set (name,_) -> NameSet.add name set) NameSet.empty named in
let named = List.fold_left (fun map (name,g) -> NameMap.add name g map) NameMap.empty named in
let get_named ?add name = NameMap.find_opt name named in
let add = None in
{ add ; default ; named = (fun () -> named_set) ; get_named }
;;
let dataset ?add ?get_named ?(named=fun () -> NameSet.empty) default =
match get_named with
None -> simple_dataset default
| Some get_named -> { add ; default ; named ; get_named }
;;
let mem_dataset default_graph =
let graphs = ref NameMap.empty in
let f_add ?name g =
let name = match name with None -> `I (g.Graph.name ()) | Some n -> n in
match NameMap.find_opt name !graphs with
| None -> graphs := NameMap.add name g !graphs; g
| Some g0 -> Graph.merge g g0; g0
in
let get_named ?(add=false) name =
match NameMap.find_opt name !graphs with
| Some g -> Some g
| None when not add -> None
| None ->
let g =
let base = match name with
| `B _ -> Iri.of_string ""
| `I i -> i
in
Graph.open_graph base
in
Some (f_add ~name g)
in
let named () = NameSet.of_list (List.map fst (NameMap.bindings !graphs)) in
dataset ~add:f_add ~get_named ~named default_graph
let graphs ds =
NameSet.fold
(fun name acc ->
match ds.get_named name with
| None -> acc
| Some g -> (Some name, g) :: acc
)
(ds.named()) [(None, ds.default)]
let merge_to_default ds =
List.iter
(fun (name, g) ->
match name with
| None -> ()
| Some _ -> Graph.merge ds.default g)
(graphs ds)
let iter f ds = List.iter (fun (name,g) -> f name g) (graphs ds)
let fold f acc ds =
List.fold_left (fun acc (name, g) -> f acc name g) acc (graphs ds)
type diff =
| Cardinals of int * int
| Missing_graph of name
| Graph_diff of name option * Graph.diff
let string_of_diff = function
| Cardinals (c1, c2) -> Printf.sprintf "Cardinals differ: %d <> %d" c1 c2
| Missing_graph name -> Printf.sprintf "Missing graph %s" (string_of_name name)
| Graph_diff (name, d) -> Printf.sprintf "Diff in graph %s: %s"
(match name with None -> "[default]" | Some n -> string_of_name n)
(Graph.string_of_diff d)
let pp_diff ppf diff = Format.fprintf ppf "%s" (string_of_diff diff)
let isomorphic_diff =
let f ~ignore_blanks ds2 acc name g1 =
match acc with
| Some d -> acc
| None ->
match name with
| _ when g1.Graph.size () = 0 -> acc
| Some (`B _) when ignore_blanks -> acc
| _ ->
let g2 =
match name with
| None -> Some ds2.default
| Some name -> ds2.get_named name
in
match g2, name with
| None, None -> assert false
| None, Some name -> Some (Missing_graph name)
| Some g2, _ ->
match Graph.isomorphic_diff ~ignore_blanks g1 g2 with
| None -> acc
| Some d -> Some (Graph_diff (name, d))
in
fun ?(ignore_blanks=false) ds1 ds2 ->
let card ds =
fold (fun acc name g -> if g.size() > 0 then acc + 1 else acc) 0 ds
in
let card1 = card ds1 in
let card2 = card ds2 in
if card1 <> card2 then
Some (Cardinals (card1, card2))
else
fold (f ~ignore_blanks ds2) None ds1