skos/commit

wip on skos viz

diff --git a/components/skos/components.pl b/components/skos/components.pl
new file mode 100644
index 0000000..ce174b4
--- /dev/null
+++ b/components/skos/components.pl
@@ -0,0 +1,162 @@
+:- module(skos,
+	  [ skos_display_link//2,	% +URI, +Options
+	    skos_concept_view//2		% +URI, +Options
+	  ]).
+
+:- use_module(library(http/page_info)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/html_head)).
+:- use_module(library(http/http_path)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_wrapper)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(semweb/rdfs)).
+:- use_module(library(semweb/rdf_label)).
+
+:- use_module(library(sgml)).
+
+:- use_module(components(label)).
+:- use_module(user(preferences)).
+:- use_module(cliopatria(hooks)).
+
+/** <module> Domain-specific components for SKOS models
+*/
+
+%%	skos_display_link(+URI, +Options)// is semidet.
+%
+
+skos_display_link(SKOSXL, Options) -->
+	{ \+ memberchk(skos(false), Options),
+	   rdfs_individual_of(SKOSXL, 'http://www.w3.org/2008/05/skos-xl#Label'),
+	   rdf_has(SKOSXL, 'http://www.w3.org/2008/05/skos-xl#literalForm', Literal),
+	   resource_link(SKOSXL, HREF)
+	},
+        html(a([class(r_def), href(HREF)], ['xl: ', \turtle_label(Literal)])).
+
+%%	edm_proxy_view(+URI, +Options)// is det.
+%
+%	Provide a _|local view|_ for an EDM ore:Proxy object. The caller
+%	must ensure that URI is indeed of type ore:Proxy.
+
+skos_concept_view(URI, _Options) -->
+	{ fail, type_styles(URI, Styles),
+	  http_current_request(Request),
+	  http_reload_with_parameters(Request, [raw(true)], FullHREF)
+	},
+	html_requires(css('edm.css')),
+	html(div(class(Styles),
+		 [ \values(div, URI, dcterms:title),
+		   \values(div, URI, ore:proxyIn -> ens:hasThumbnail),
+		   \values(div, URI, dcterms:creator),
+		   div(class(created), \values(span, URI, dcterms:created)),
+		   div(class(extent), \values(span, URI, dcterms:extent)),
+		   \values(div, URI, dcterms:description),
+		   div(class(owner),
+		       [ \values(span, URI, dcterms:rights),
+			 \values(span, URI, dcterms:identifier)
+		       ]),
+		   br(clear(all)),
+		   div(class(fullview), a(href(FullHREF), 'Full view'))
+		 ])).
+
+type_styles(URI, Styles) :-
+	findall(Style, type_style(URI, Style), Styles).
+
+type_style(URI, Class) :-
+	rdf_has(URI, rdf:type, Type),
+	uri_css_class(Type, Class).
+
+values(Element, URI, Path) -->
+	{ has_values(URI, Path, Pairs)
+	},
+	values(Pairs, Element).
+
+values([], _) --> [].
+values([V-Classes|T], Element) -->
+	{ HTML =.. [Element, class(Classes), \value(V)] },
+	html(HTML),
+	values(T, Element).
+
+
+%%	has_values(+URI, +Path, -Pairs) is det.
+%
+%	Pairs is a list of Value-Classes pairs.
+
+has_values(URI, Path, Pairs) :-
+	findall(Value-Classes, has_value(Path, URI, Classes, Value), Pairs0),
+	partition(pair_preferred_lang, Pairs0, Preferred, NonPreferred),
+	(   Preferred == []
+	->  Pairs = NonPreferred
+	;   Pairs = Preferred
+	).
+
+pair_preferred_lang(Value-_CSS) :-
+	preferred_lang(Value).
+
+has_value(P0->P, URI, Classes, Value) :- !,
+	has_value(P0, URI, Classes0, Value0),
+	has_value(P, Value0, Classes1, Value),
+	append(Classes0, Classes1, Classes).
+has_value(NS:Local, URI, Class, Value) :- !,
+	rdf_global_id(NS:Local, P),
+	has_value(P, URI, Class, Value).
+has_value(P, URI, Classes, Value) :-
+	rdf_has(URI, P, Value, RP),
+	p_classes(RP, P, Classes).
+
+%%	p_classes(+FoundPred, +QueryPred, -CSSClasses) is det.
+%
+%	@tbd	Find intermediate properties
+
+p_classes(RP, RP, [RC]) :- !,
+	uri_css_class(RP, RC).
+p_classes(RP, P, [RC, PC]) :-
+	uri_css_class(P, PC),
+	uri_css_class(RP, RC).
+
+uri_css_class(URI, Class) :-
+	iri_xml_namespace(URI, _, Class).
+
+
+%%	value(+Value)// is det.
+%
+%	Show the actual value
+
+value(Literal) -->
+	{ rdf_is_literal(Literal), !,
+	  literal_text(Literal, Text)
+	},
+	html(Text).
+value(R) -->
+	rdf_link(R).
+
+%%	preferred_lang(+Object)
+%
+%	True if Object is stated in the   preferred language of the user
+%	or language-neutral.
+
+preferred_lang(Literal) :-
+	literal_lang(Literal, Lang), !,
+	user_preference(user:lang, literal(PrefLang)),
+	lang_matches(PrefLang, Lang).
+preferred_lang(R) :-			% see bnode_label//1.
+	rdf_label(R, Value),
+	literal_lang(Value, Lang), !,
+	user_preference(user:lang, literal(PrefLang)),
+	lang_matches(PrefLang, Lang).
+preferred_lang(BNode) :-		% see bnode_label//1.
+	rdf_is_bnode(BNode),
+	rdf_has(BNode, rdf:value, Value),
+	literal_lang(Value, Lang), !,
+	user_preference(user:lang, literal(PrefLang)),
+	lang_matches(PrefLang, Lang).
+preferred_lang(_).
+
+literal_lang(literal(lang(Lang, _)), Lang).
+
+rdf_label:display_label_hook(SKOS, Lang, Literal) :-
+        ( ground(Lang) ; Lang = en),
+        rdfs_individual_of(SKOS, skos:'Concept'),
+        rdf_has(SKOS, 'http://www.w3.org/2008/05/skos-xl#prefLabel', SKOSXL),
+        rdf_has(SKOSXL, 'http://www.w3.org/2008/05/skos-xl#literalForm', literal(lang(Lang,Literal))).
+
diff --git a/components/skos/graph.pl b/components/skos/graph.pl
new file mode 100644
index 0000000..ab939e4
--- /dev/null
+++ b/components/skos/graph.pl
@@ -0,0 +1,120 @@
+:- module(skos_graph,
+	  [ skos_context_graph/3,	% +URI, -Graph, +Options
+	    skos_node_shape/3		% +URI, -Shape, +Options
+	  ]).
+:- use_module(cliopatria(hooks)).
+:- use_module(library(uri)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(semweb/rdfs)).
+:- use_module(library(semweb/rdf_abstract)).
+:- use_module(library(http/page_info)).
+:- use_module(library(http/html_write)).
+:- use_module(library(lists)).
+:- use_module(components(label)).
+:- use_module(library(settings)).
+:- use_module(library(count)).
+
+/** <module> SKOS Context graphs
+
+This module customises context graphs, both in how they are computed and
+in the rendering of the SKOS classes.
+
+@see cliopatria(hooks) for a description of the hooks.
+*/
+
+% Use SVG context graphs
+
+:- set_setting_default(graphviz:format, svg).
+
+%%	skos_context_graph(+URI, -Graph, +Options)
+%
+%	Compute the EDM context graph. This is currently defined to do a
+%	two-step breadth-first expansion of the graph from URI using the
+%	known EDM properties. Branching from a single node is limited to
+%	20 and the total graph is not expanded beyond 100 nodes.
+
+:- rdf_meta
+	skos_relation(r),
+	skos_class(r).
+
+skos_context_graph(R, RDF, Options) :-
+	option(style(skos), Options),
+	bf_graph(R, 2, 100, 20, RDF0),
+	minimise_graph(RDF0, RDF1),		% remove inverse/symmetric/...
+	bagify_graph(RDF1, RDF2, Bags, []), 	% Create bags of similar resources
+	append(RDF2, Bags, RDF),
+	graph_resources(RDF, Resources, _Preds, _Types),
+	include(skos_resource, Resources, EDMResources),
+	EDMResources = [_,_|_].
+
+%%	bf_graph(+Start, +MaxDist, +MaxEdges, +MaxBranch, -Graph)
+
+bf_graph(Start, MaxDist, MaxEdges, MaxBranch, Graph) :-
+	bf_graph_2([0-Start], MaxDist, MaxEdges, MaxBranch, [], Graph).
+
+bf_graph_2([], _, _, _, G, G) :- !.
+bf_graph_2([D-_|_], MaxDist, _, _, G, G) :-
+	D >= MaxDist, !.
+bf_graph_2(AG0, MaxDist, MaxEdges, MaxBranch, G0, G) :-
+	bf_expand(AG0, AG, MaxBranch, G1),
+	(   G1 == []
+	->  bf_graph_2(AG, MaxDist, MaxEdges, MaxBranch, G0, G)
+	;   append(G1, G0, G2),
+	    sort(G2, G3),
+	    length(G3, Edges),
+	    (   Edges >= MaxEdges
+	    ->  G = G0
+	    ;   bf_graph_2(AG, MaxDist, MaxEdges, MaxBranch, G3, G)
+	    )
+	).
+
+bf_expand([D-F|AG0], AG, MaxBranch, Triples) :-
+	D1 is D + 1,
+	Key = D1-Dst,
+	answer_set(Key-Triple, related(F, Dst, Triple), MaxBranch, Pairs),
+	pairs_keys_values(Pairs, Dsts, Triples),
+	append(AG0, Dsts, AG).
+
+related(S, O, rdf(S,P,O)) :-
+	skos_relation(Rel),
+	rdf_has(S, Rel, O, P).
+related(O, S, rdf(S,P,O)) :-
+	skos_relation(Rel),
+	rdf_has(S, Rel, O, P).
+
+skos_relation(skos:semanticRelation).
+
+
+skos_resource(R) :-
+	skos_class(Class),
+	rdfs_individual_of(R, Class), !.
+
+skos_class(skos:'Concept').
+
+
+%%	skos_node_shape(+URI, -Shape, +Options)
+%
+%	Realise   EDM-specific   vizualisation   of     nodes   in   the
+%	context-graph.
+
+skos_node_shape(URI, Shape, Options) :-
+	option(style(skos), Options),
+	node_shape(URI, Shape, Options).
+
+node_shape(URI, Shape, Options) :-
+	memberchk(start(URI), Options),
+	Shape = [shape(tripleoctagon),style(filled),fillcolor('#ff85fd')].
+node_shape(URI, Shape, _Options) :-
+	rdf_has(URI, rdf:type, ens:'WebResource'),
+	page_content_type(URI, Type),
+	sub_atom(Type, 0, _, _, 'image/'),
+	Shape = [img([src(URI)])].
+node_shape(URI, Shape, _Options) :-
+	rdf_has(URI, rdf:type, ore:'Aggregation'),
+	Shape = [shape(box3d),style(filled),fillcolor('#85fff7')].
+node_shape(URI, Shape, _Options) :-
+	rdf_has(URI, rdf:type, ore:'Proxy'),
+	Shape = [shape(diamond),style('rounded,filled'),fillcolor('#ffb785')].
+node_shape(URI, Shape, _Options) :-
+	rdf_has(URI, rdf:type, ens:'PhysicalThing'),
+	Shape = [shape(house),style('filled'),fillcolor('#ff8585')].