aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-06-21 18:20:23 +0200
committerpukkamustard <pukkamustard@posteo.net>2021-06-21 18:20:23 +0200
commit9d992a8137b9a36be032dcecced141048507c7a2 (patch)
treef2a4258cf2286dc76c8c5afb3322ce8abe257a8f
parent16f435ad13c2bed7deb8f056230faf6ab704fb5e (diff)
Rdf.Graph: Reimplement with Map from the standard library
-rw-r--r--lib/core/graph.ml158
-rw-r--r--lib/core/rdf.mli30
2 files changed, 126 insertions, 62 deletions
diff --git a/lib/core/graph.ml b/lib/core/graph.ml
index b097af1..b5ad5fc 100644
--- a/lib/core/graph.ml
+++ b/lib/core/graph.ml
@@ -1,63 +1,123 @@
-(* This is a simple functional RDF graph structure.
+(* This is a simple functional RDF graph structure using `Map`s and `Set`s.
- It uses CCMultiMap with keys of type Triple.Subject.t and values of type
- (Triple.Predicate.t * Triple.Object.t).
-
- This allows efficient quering in the order subject -> predicate -> object.But
- not in any other.
-
- This can be improved.
+ This allows efficient quering in the order subject -> predicate -> object.
+ But not in any other.This can be improved.
*)
-module OrderedSubject = struct
- type t = Triple.Subject.t
-
- let compare a b =
- Term.compare
- (Triple.Subject.to_term a)
- (Triple.Subject.to_term b)
-end
-
-module OrderedPredicateObject = struct
- type t = Triple.Predicate.t * Triple.Object.t
+module TermMap = Map.Make(Term)
+module TermSet = Set.Make(Term)
- let compare (a_p,a_o) (b_p,b_o) =
- let p_compared = Term.compare
- (Triple.Predicate.to_term a_p)
- (Triple.Predicate.to_term b_p) in
- if p_compared = 0 then
- Term.compare
- (Triple.Predicate.to_term a_o)
- (Triple.Predicate.to_term b_o)
- else
- p_compared
-end
+type t = (TermSet.t TermMap.t) TermMap.t
-module GraphMap = CCMultiMap.Make(OrderedSubject)(OrderedPredicateObject)
+let empty = TermMap.empty
-type t = GraphMap.t
+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 empty = GraphMap.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 graph (triple:Triple.t) =
- GraphMap.add graph triple.subject (triple.predicate, triple.object')
+ triple
+ |> singleton
+ |> union graph
let add_seq graph triples =
Seq.fold_left add graph triples
-let remove_triple graph (triple:Triple.t) =
- GraphMap.remove graph triple.subject (triple.predicate, triple.object')
-
-let union = GraphMap.union
-
-let difference = GraphMap.diff
-
-let intersection = GraphMap.inter
-
-let member_subject =
- GraphMap.mem
+(* 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 graph (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.update s
+ (fun pos_opt -> Option.bind pos_opt (remove_p p o))
+ graph
+
+let subjects graph =
+ TermMap.to_seq graph
+ |> Seq.map (fun (s, _pos) -> s)
+
+(* 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 to_triples graph =
+ TermMap.to_seq graph
+ |> _pos_seq_to_triples
+
+let to_triples_s graph subject =
+ TermMap.to_seq_from subject graph
+ |> _pos_seq_to_triples
+
+let to_triples_sp graph subject predicate =
+ match TermMap.find_opt subject graph with
+ | None -> Seq.empty
+ | Some pos ->
+ TermMap.to_seq_from predicate pos
+ |> _os_seq_to_triples subject
-let to_list graph =
- GraphMap.fold graph []
- (fun triples subject (predicate, object') ->
- Triple.make subject predicate object' :: triples)
diff --git a/lib/core/rdf.mli b/lib/core/rdf.mli
index 90983fe..4ec8f21 100644
--- a/lib/core/rdf.mli
+++ b/lib/core/rdf.mli
@@ -227,6 +227,12 @@ module Graph : sig
val empty : t
(** [empty] is the empty graph. *)
+ val singleton : Triple.t -> t
+ (** [singleton triple] returns a graph containg only [triple]. *)
+
+ val union : t -> t -> t
+ (** [union a b] returns the union of the graphs. *)
+
val add : t -> Triple.t -> t
(** [add graph triple] returns a new graph containing [triple] (and everything in [graph]).*)
@@ -234,22 +240,20 @@ module Graph : sig
(** [add_seq graph triples] returns a new graph containing all triples in the
sequence [triples]. *)
- val remove_triple : t -> Triple.t -> t
+ val remove: t -> Triple.t -> t
(** [remove_triple graph triple] removes [triple] from [graph]. *)
- val union : t -> t -> t
- (** [union a b] returns the union of the graphs. *)
-
- val difference : t -> t -> t
- (** [difference a b] returns the difference of the graphs. *)
+ val subjects : t -> Term.t Seq.t
+ (** [subjects graph] returns a sequence of subjects that appear in the graph. *)
- val intersection : t -> t -> t
- (** [intersection a b] returns the intersection of the graphs. *)
+ val to_triples: t -> Triple.t Seq.t
+ (** [to_triples graph] returns a sequence of triples in [graph].*)
- val member_subject : t -> Triple.Subject.t -> bool
- (** [member_subject graph subject] returns true if [subject] appears in
- [graph].*)
+ val to_triples_s : t -> Term.t -> Triple.t Seq.t
+ (** [to_seq_s graph subject] returns a sequence of triples in [graph] with
+ [subject] in subject position.*)
- val to_list: t -> Triple.t list
- (** [to_list graph] returns a sequence of triples in [graph].*)
+ val to_triples_sp : t -> Term.t -> Term.t -> Triple.t Seq.t
+ (** [to_seq_sp graph subject predicate] returns a sequence of triples in [graph] with
+ [subject] in subject position and [predicate] in predicate position.*)
end