aboutsummaryrefslogtreecommitdiff
path: root/lib/core/graph.ml
blob: f923a4ed7d41dd973f9fb2954fcd0f71d7656213 (plain)
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
(* This is a simple functional RDF graph structure using `Map`s and `Set`s.

   This allows efficient quering in the order subject -> predicate -> object.
   But not in any other.This can be improved.
*)

module TermMap = Map.Make(Term)
module TermSet = Set.Make(Term)

type t = (TermSet.t TermMap.t) TermMap.t

let equal = TermMap.equal (TermMap.equal TermSet.equal)

let empty = TermMap.empty

let singleton (triple:Triple.t) =
  let s = triple.subject |> Triple.Subject.to_term in
  let p = triple.predicate |> Triple.Predicate.to_term in
  let o = triple.object' |> Triple.Object.to_term in
  TermMap.add s
    (TermMap.add p (TermSet.singleton o) empty)
    empty

let union a b =
  TermMap.union
    (fun _subject left right ->
       Some (TermMap.union
               (fun _predicate left right ->
                  Some (TermSet.union left right))
               left right))
    a b

let add (triple:Triple.t) graph =
  triple
  |> singleton
  |> union graph

let add_seq triples graph =
  Seq.fold_left
    (fun graph triple -> add triple graph)
    graph triples

(* Remove object [o] from set of objects [os] but return None if resulting set is empty. *)
let remove_o o os =
  let os_removed = TermSet.remove o os in
  if TermSet.is_empty os_removed then
    None
  else
    Some os_removed

(* Remove object [o] from predicate-objects map [pos]. If resulting map is empty return None. *)
let remove_p p o pos =
  let pos_removed =
    TermMap.update p
      (fun os_opt -> Option.bind os_opt (remove_o o))
      pos
  in
  if TermMap.is_empty pos_removed then
    None
  else
    Some pos_removed

let remove (triple:Triple.t) graph =
  let s = triple.subject |> Triple.Subject.to_term in
  let p = triple.predicate |> Triple.Predicate.to_term in
  let o = triple.object' |> Triple.Object.to_term in
  TermMap.update s
    (fun pos_opt -> Option.bind pos_opt (remove_p p o))
    graph


(* Helpers to cast to Triple positional terms *)

let _to_subject s =
  Term.map s
    Triple.Subject.of_iri
    Triple.Subject.of_blank_node
    (fun _ -> failwith "unexpected literal in subject position")

let _to_predicate p =
  Term.map p
    Triple.Predicate.of_iri
    (fun _ -> failwith "unexpected blank node in predicate position")
    (fun _ -> failwith "unexpected literal in predicate position")

let _to_object s =
  Term.map s
    Triple.Object.of_iri
    Triple.Object.of_blank_node
    Triple.Object.of_literal

(* create a stream of triples from a stream of object-sets *)
let _os_seq_to_triples s =
  Seq.flat_map (fun (p, os) ->
      TermSet.to_seq os
      |> Seq.map (fun o ->
          Triple.make
            (_to_subject s)
            (_to_predicate p)
            (_to_object o)))


(* Helper to create a stream of triples from a stream of predicate-object-set
   maps *)
let _pos_seq_to_triples =
  Seq.flat_map (fun (s, pos) ->
      TermMap.to_seq pos
      |> _os_seq_to_triples s
    )

let subjects graph =
  TermMap.to_seq graph
  |> Seq.map (fun (s, _pos) -> _to_subject s)

let to_triples graph =
  TermMap.to_seq graph
  |> _pos_seq_to_triples

let to_triples_s subject graph =
  TermMap.to_seq_from subject graph
  |> _pos_seq_to_triples

let to_triples_sp subject predicate graph =
  match TermMap.find_opt subject graph with
  | None -> Seq.empty
  | Some pos ->
    TermMap.to_seq_from predicate pos
    |> _os_seq_to_triples subject

let pp ppf graph =
  Fmt.pf ppf "%a"
    (Fmt.seq Triple.pp)
    (to_triples graph)

let to_nested_seq graph =
  TermMap.to_seq graph
  |> Seq.map (fun (s, pos) ->
      _to_subject s,
      pos
      |> TermMap.to_seq
      |> Seq.map (fun (p, os) ->
          _to_predicate p,
          os
          |> TermSet.to_seq
          |> Seq.map _to_object))