1/*  Part of ClioPatria SeRQL and SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2010-2018, University of Amsterdam,
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(rdf_abstract,
   37          [ merge_sameas_graph/3,       % +GraphIn, -GraphOut, +Options
   38            bagify_graph/4,             % +GraphIn, -GraphOut, -Bags, +Options
   39            abstract_graph/3,           % +GraphIn, -GraphOut, +Options
   40            minimise_graph/2,           % +GraphIn, -GraphOut
   41
   42            graph_resources/2,          % +Graph, -Resources
   43            graph_resources/4           % +Graph, -Resources, -Predicates, -Types
   44          ]).   45:- use_module(library(semweb/rdf_db)).   46:- use_module(library(semweb/rdfs)).   47:- use_module(library(assoc)).   48:- use_module(library(option)).   49:- use_module(library(pairs)).   50:- use_module(library(ordsets)).   51:- use_module(library(debug)).   52:- use_module(library(apply)).   53:- use_module(library(lists)).   54:- use_module(library(settings)).

 merge_sameas_graph(GraphIn, GraphOut, +Options) is det

Collapse nodes in GraphIn that are related through an identity mapping. By default, owl:sameAs is the identity relation. Options defines:

predicate(-PredOrList)

Use an alternate or list of predicates that are to be treated as identity relations.

sameas_mapped(-Assoc)

Assoc from resources to the resource it was mapped to.

   86:- rdf_meta
   87    merge_sameas_graph(+, -, t).   88
   89merge_sameas_graph(GraphIn, GraphOut, Options) :-
   90    sameas_spec(Options, SameAs),
   91    sameas_map(GraphIn, SameAs, Assoc),             % R->EqSet
   92    (   empty_assoc(Assoc)
   93    ->  GraphOut = GraphIn,
   94        empty_assoc(EqMap)
   95    ;   assoc_to_list(Assoc, List),
   96        pairs_values(List, EqSets),
   97        sort(EqSets, UniqueEqSets),
   98        map_list_to_pairs(rdf_representative, UniqueEqSets, Keyed), % Repr-EqSet
   99        representer_map(Keyed, EqMap),
  100        map_graph(GraphIn, EqMap, GraphOut),
  101        (   debugging(abstract)
  102        ->  length(GraphIn, Before),
  103            length(GraphOut, After),
  104            debug(abstract, 'owl:sameAs reduction: ~D --> ~D edges', [Before, After])
  105        ;   true
  106        )
  107    ),
  108    option(sameas_mapped(EqMap), Options, _).
  109
  110sameas_spec(Options, SameAs) :-
  111    rdf_equal(owl:sameAs, OwlSameAs),
  112    option(predicate(SameAs0), Options, OwlSameAs),
  113    (   is_list(SameAs0)
  114    ->  SameAs = SameAs0
  115    ;   SameAs = [SameAs0]
  116    ).

 sameas_map(+Graph, +SameAs, -Map:assoc) is det

Create an assoc with R->Set, where Set contains an ordered set of resources equivalent to R.

  123sameas_map(Graph, SameAs, Assoc) :-
  124    empty_assoc(Assoc0),
  125    sameas_map(Graph, SameAs, Assoc0, Assoc).
  126
  127sameas_map([], _, Assoc, Assoc).
  128sameas_map([rdf(S, P, O)|T], SameAs, Assoc0, Assoc) :-
  129    same_as(P, SameAs),
  130    S \== O,
  131    !,
  132    (   get_assoc(S, Assoc0, SetS)
  133    ->  (   get_assoc(O, Assoc0, SetO)
  134        ->  ord_union(SetO, SetS, Set)
  135        ;   ord_union([O], SetS, Set)
  136        )
  137    ;   (   get_assoc(O, Assoc0, SetO)
  138        ->  ord_union([S], SetO, Set)
  139        ;   sort([S,O], Set)
  140        )
  141    ),
  142    putall(Set, Assoc0, Set, Assoc1),
  143    sameas_map(T, SameAs, Assoc1, Assoc).
  144sameas_map([_|T], SameAs, Assoc0, Assoc) :-
  145    sameas_map(T, SameAs, Assoc0, Assoc).
  146
  147putall([], Assoc, _, Assoc).
  148putall([H|T], Assoc0, Value, Assoc) :-
  149    put_assoc(H, Assoc0, Value, Assoc1),
  150    putall(T, Assoc1, Value, Assoc).

 same_as(+Predicate:resource, +SameAs:list) is semidet

True if Predicate expresses a same-as mapping.

  157same_as(P, Super) :-
  158    member(S, Super),
  159    rdfs_subproperty_of(P, S),
  160    !.

 representer_map(+List:list(Repr-Set), -Assoc) is det

Assoc maps all elements of Set to its representer.

  167representer_map(Keyed, EqMap) :-
  168    empty_assoc(Assoc0),
  169    representer_map(Keyed, Assoc0, EqMap).
  170
  171representer_map([], Assoc, Assoc).
  172representer_map([R-Set|T], Assoc0, Assoc) :-
  173    putall(Set, Assoc0, R, Assoc1),
  174    representer_map(T, Assoc1, Assoc).
  175
  176
  177                 /*******************************
  178                 *             BAGIFY           *
  179                 *******************************/

 bagify_graph(+GraphIn, -GraphOut, -Bags, +Options) is det

If a graph contains multiple objects of the same type (class) in the same location in the graph (i.e. all links are the same), create a bag. The bag is represented by a generated resource of type rdf:Bag and the RDF for the bags is put in Bags. I.e. appending GraphOut and Bags provides a proper RDF model. Options provides additional abstraction properties. In particular:

class(+Class)

Try to bundle objects under Class rather than their rdf:type. Multiple of these options may be defined

property(+Property)

Consider predicates that are an rdfs:subPropertyOf Property the same relations.

bagify_literals(+Bool)

If true (default), also try to put literals into a bag. Works well to collapse non-preferred labels.

To be done

- Handle the property option

  204:- rdf_meta
  205    bagify_graph(+, -, -, t).  206
  207bagify_graph(GraphIn, GraphOut, Bags, Options) :-
  208    canonise_options(Options, Options1),
  209    partition_options(class, Options1, ClassOptions, Options2),
  210    graph_node_edges(GraphIn, AssocNodesToEdges, Options2),
  211    assoc_to_list(AssocNodesToEdges, NodesToEdges),
  212    pairs_keys(NodesToEdges, Nodes),
  213    group_resources_by_class(Nodes, ByClass, ClassOptions),
  214    resource_bags(ByClass, NodesToEdges, RawBags),
  215    (   debugging(abstract)
  216    ->  length(RawBags, Len),
  217        maplist(length, RawBags, BagLens),
  218        sumlist(BagLens, ObjCount),
  219        debug(abstract, 'Created ~D bags holding ~D objects', [Len, ObjCount])
  220    ;   true
  221    ),
  222    assign_bagids(RawBags, IDBags),
  223    representer_map(IDBags, Assoc),
  224    map_graph(GraphIn, Assoc, GraphOut0),
  225    merge_properties(GraphOut0, GraphOut, Options2),
  226    make_rdf_graphs(IDBags, Bags).
  227
  228partition_options(Name, Options, WithName, WithoutName) :-
  229    partition(option_name(Name), Options, WithName, WithoutName).
  230
  231option_name(Name, Option) :-
  232    functor(Option, Name, 1).

 canonise_options(+OptionsIn, -OptionsOut) is det

Rewrite option list from possible Name=Value to Name(Value)

  238canonise_options(In, Out) :-
  239    memberchk(_=_, In),            % speedup a bit if already ok.
  240    !,
  241    canonise_options2(In, Out).
  242canonise_options(Options, Options).
  243
  244canonise_options2([], []).
  245canonise_options2([Name=Value|T0], [H|T]) :-
  246    !,
  247    H =.. [Name,Value],
  248    canonise_options2(T0, T).
  249canonise_options2([H|T0], [H|T]) :-
  250    !,
  251    canonise_options2(T0, T).

 group_resources_by_class(+Resources, -ByClass, +Options) is det

ByClass is a list of lists of resources that belong to the same class. First step we process the classes specified in Options.

  261group_resources_by_class([], [], _) :- !.
  262group_resources_by_class(Resources, ByClass, Options) :-
  263    select_option(class(Class), Options, Options1),
  264    !,
  265    (   partition(has_class(sub_class, Class), Resources, InClass, NotInClass),
  266        InClass \== []
  267    ->  ByClass = [InClass|ByClass1],
  268        group_resources_by_class(NotInClass, ByClass1, Options1)
  269    ;   group_resources_by_class(Resources, ByClass, Options1)
  270    ).
  271group_resources_by_class([H|T0], [[H|S]|T], Options) :-
  272    class_of(H, exact, Class),
  273    partition(has_class(exact, Class), T0, S, T1),
  274    group_resources_by_class(T1, T, Options).

 has_class(+Match, +Class, +Node) is semidet

  278has_class(Match, Class, Node) :-
  279    class_of(Node, Match, Class).

 class_of(+Node, +Match, -Class) is det

class_of(+Node, +Match, +Class) is semidet

  284class_of(Node, sub_class, Class) :-
  285    !,
  286    rdfs_individual_of(Node, Class),
  287    !.
  288class_of(literal(_), exact, Literal) :-
  289    !,
  290    rdf_equal(Literal, rdfs:'Literal').
  291class_of(R, exact, Class) :-
  292    rdf_has(R, rdf:type, Class),
  293    !.
  294class_of(_, exact, Class) :-
  295    rdf_equal(Class, rdfs:'Resource').

 resource_bags(+ByClass:list(list(resource)), +NodeToEdges:list(node-list(edges)), -RawBags:list(list(resource))) is det

Find bags of resources that have the same connections.

  304resource_bags(ByClass, NodeToEdges, Bags) :-
  305    phrase(resource_bags(ByClass, NodeToEdges), Bags).
  306
  307resource_bags([], _) -->
  308    [].
  309resource_bags([ByClassH|ByClassT], NodeToEdges) -->
  310    { sort(ByClassH, SortedNodes),
  311      ord_subkeys(SortedNodes, NodeToEdges, SubNodeToEdges),
  312      same_edges(SubNodeToEdges, Bags)
  313    },
  314    Bags,
  315    resource_bags(ByClassT, NodeToEdges).

 ord_subkeys(+Keys, +Pairs, -SubPairs) is det

SubPairs is the sublist of Pairs with a key in Keys.

Arguments:

Keys	- Sorted list of keys
Pairs	- Key-sorted pair-list
SubPairs	- Key-sorted pair-list

  325ord_subkeys([], _, []).
  326ord_subkeys([K|KT], [P|PT], Pairs) :-
  327    P = PK-_,
  328    compare(Diff, K, PK),
  329    ord_subkeys(Diff, K, KT, P, PT, Pairs).
  330
  331ord_subkeys(=, _, KT, P, PT, [P|Pairs]) :-
  332    !,
  333    ord_subkeys(KT, PT, Pairs).
  334ord_subkeys(<, _, [K|KT], P, PT, Pairs) :-
  335    P = PK-_,
  336    compare(Diff, K, PK),
  337    ord_subkeys(Diff, K, KT, P, PT, Pairs).
  338ord_subkeys(>, K, KT, _, [P|PT], Pairs) :-
  339    P = PK-_,
  340    compare(Diff, K, PK),
  341    ord_subkeys(Diff, K, KT, P, PT, Pairs).

 same_edges(+NodeToEdges:list(node-edges), -Bags:list(list)) is det

Bags is a list of lists of resources (nodes) that share the same (abstracted) edges with the rest of the graph.

  349same_edges(NodeToEdges, Bags) :-
  350    transpose_pairs(NodeToEdges, ByEdges),          % list(edges-node)
  351    keysort(ByEdges, Sorted),
  352    group_pairs_by_key(Sorted, Grouped),
  353    pairs_values(Grouped, AllBySameEdge),
  354    include(longer_than_one, AllBySameEdge, Bags).
  355
  356longer_than_one([_,_|_]).

 graph_node_edges(+Graph, -NodeEdges:assoc, +Options) is det

NodeEdges is an assoc from resource to a sorted list of involved triples. Only subject and objects are considered.

Processes bagify_literals and property options

  365graph_node_edges(Graph, Assoc, Options) :-
  366    option(bagify_literals(LitToo), Options, true),
  367    property_map(Options, Map0),
  368    empty_assoc(Assoc0),
  369    graph_node_edges(Graph, LitToo, Map0, Assoc0, Assoc1),
  370    map_assoc(sort, Assoc1, Assoc).
  371
  372graph_node_edges([], _, _, Assoc, Assoc).
  373graph_node_edges([rdf(S,P,O)|T], LitToo, Map, Assoc0, Assoc) :-
  374    abstract_property(P, Map, SP, Map1),
  375    add_assoc(S, Assoc0, rdf(-, SP, O), Assoc1),
  376    (   (atom(O) ; LitToo == true )
  377    ->  add_assoc(O, Assoc1, rdf(S, SP, -), Assoc2)
  378    ;   Assoc2 = Assoc1
  379    ),
  380    graph_node_edges(T, LitToo, Map1, Assoc2, Assoc).
  381
  382add_assoc(Key, Assoc0, Value, Assoc) :-
  383    get_assoc(Key, Assoc0, Old, Assoc, [Value|Old]),
  384    !.
  385add_assoc(Key, Assoc0, Value, Assoc) :-
  386    put_assoc(Key, Assoc0, [Value], Assoc).

 property_map(+Options, -Map:assoc(P-Super))

Process the options, creating a map that replaces a property by its registered super.

  394property_map(Options, Map) :-
  395    empty_assoc(Map0),
  396    property_map(Options, Map0, Map).
  397
  398property_map([], Map, Map).
  399property_map([property(P)|T], Map0, Map) :-
  400    !,
  401    (   rdfs_subproperty_of(P, Super),
  402        get_assoc(Super, Map0, Root)
  403    ->  put_assoc(P, Map0, Root, Map1)
  404    ;   put_assoc(P, Map0, P, Map1)
  405    ),
  406    property_map(T, Map1, Map).
  407property_map([_|T], Map0, Map) :-
  408    property_map(T, Map0, Map).

 abstract_property(+P0, +Map0, -P, -Map) is det

Find the abstract property for some property P.

  414abstract_property(P0, Map0, P, Map) :-
  415    get_assoc(P0, Map0, P),
  416    !,
  417    Map = Map0.
  418abstract_property(P, Map0, Root, Map) :-
  419    rdfs_subproperty_of(P, Super),
  420    get_assoc(Super, Map0, Root),
  421    !,
  422    debug(abstract(property), 'Mapped ~p --> ~p', [P, Root]),
  423    put_assoc(P, Map0, Root, Map).
  424abstract_property(P, Map, P, Map).

 assign_bagids(+Bags:list(bag), -IDBags:list(id-bag))

Assign bag identifiers to the each bag in Bags.

  431assign_bagids(Bags, IDBags) :-
  432    assign_bagids(Bags, 1, IDBags).
  433
  434assign_bagids([], _, []).
  435assign_bagids([H|T0], I, [Id-H|T]) :-
  436    atom_concat('_:bag_', I, Id),
  437    I2 is I + 1,
  438    assign_bagids(T0, I2, T).

 make_rdf_graphs(+IDBags, -RDFBags) is det

Translate BagID-Members into an RDF graph.

  445:- rdf_meta
  446    statement(r,r,o,?,?).                   % statement//3
  447
  448make_rdf_graphs(IDBags, RDFBags) :-
  449    phrase(make_rdf_graphs(IDBags), RDFBags).
  450
  451make_rdf_graphs([]) -->
  452    [].
  453make_rdf_graphs([ID-Members|T]) -->
  454    statement(ID, rdf:type, rdf:'Bag'),
  455    bag_members(Members, 0, ID),
  456    make_rdf_graphs(T).
  457
  458bag_members([], _, _) -->
  459    [].
  460bag_members([H|T], I, ID) -->
  461    { I2 is I + 1,
  462      atom_concat('_:', I, P)
  463    },
  464    statement(ID, P, H),
  465    bag_members(T, I2, ID).
  466
  467statement(S, P, O) -->
  468    [ rdf(S, P, O) ].
  469
  470
  471
  472                 /*******************************
  473                 *       MERGE PROPERTIES       *
  474                 *******************************/

 merge_properties(+GraphIn, -GraphOut, +Options) is det

Merge equivalent properties joining the same nodes. They are replaced by their common ancestors.

Arguments:

GraphIn	- List of rdf(S,P,O)
GraphOut	- List of rdf(S,P,O)
Options	- Option list (unused)

  485merge_properties([], [], _).
  486merge_properties([rdf(S,P,O)|GraphIn], GraphOut, Options) :-
  487    memberchk(rdf(S,_,O), GraphIn),
  488    !,
  489    partition(same_so(S,O), GraphIn, Same, Rest),
  490    maplist(pred, Same, Preds),
  491    sort([P|Preds], UniquePreds),
  492    common_ancestor_forest(sub_property_of, UniquePreds, Forest),
  493    pairs_keys(Forest, Roots),
  494    debug(abstract, 'Merged ~p --> ~p', [UniquePreds, Roots]),
  495    mk_p_triples(Roots, S, O, GraphOut, Out2),
  496    merge_properties(Rest, Out2, Options).
  497merge_properties([Triple|GraphIn], [Triple|GraphOut], Options) :-
  498    merge_properties(GraphIn, GraphOut, Options).
  499
  500same_so(S, O, rdf(S, _, O)).
  501pred(rdf(_,P,_), P).
  502
  503mk_p_triples([], _, _) --> [].
  504mk_p_triples([P|T], S, O) -->
  505    [rdf(S,P,O)],
  506    mk_p_triples(T, S, O).
  507
  508sub_property_of(P, Super) :-
  509    rdf_has(P, rdfs:subPropertyOf, Super).

 common_ancestor_forest(:Pred, +Objects, -Forest) is det

Forest is a minimal set of minimal spanning trees with real branching (more than one child per node) covering all Objects. The partial ordering is defined by the non-deterministic goal call(Pred, +Node, -Parent).

• Build up a graph represented as Node->Children and a list of roots. The initial list of roots is Objects. The graph is built using breath-first search to minimize depth.
• Once we have all roots, we delete all branches that have only a single child.

Arguments:

Forest

- is a list of trees. Each tree is represented as Root-Children, where Children is a possibly empty list if sub-trees.

To be done

- First prune dead-ends?

rdf_db:rdf_global_term([ulan:assisted_by, ulan:cousin_of], In),
gtrace,
rdf_abstract:common_ancestor_forest(sub_property_of, In, Out).

  539:- meta_predicate
  540    common_ancestor_forest(2, +, -).  541
  542common_ancestor_forest(Pred, Objects, Forest) :-
  543    strip_module(Pred, M, P),
  544    sort(Objects, Objects1),
  545    keys_to_assoc(Objects1, target*[], Nodes0),
  546    ancestor_tree(Objects1, M:P, Nodes0, Nodes, Roots),
  547    prune_forest(Nodes, Roots, Forest),
  548    debug(common_ancestor, 'Ancestors of ~p: ~p', [Objects1, Forest]).

 keys_to_assoc(+Keys:list, +Value, -Assoc) is det

True if Assoc is an assoc where each Key maps to Value.

  554keys_to_assoc(Keys, Value, Assoc) :-
  555    empty_assoc(Assoc0),
  556    keys_to_assoc(Keys, Assoc0, Value, Assoc).
  557
  558keys_to_assoc([], Assoc, _, Assoc).
  559keys_to_assoc([H|T], Assoc0, Value, Assoc) :-
  560    put_assoc(H, Assoc0, Value, Assoc1),
  561    keys_to_assoc(T, Assoc1, Value, Assoc).
  562
  563
  564ancestor_tree(Objects, Pred, Nodes0, Nodes, Roots) :-
  565    ancestor_tree(Objects, [], Objects, Pred, Nodes0, Nodes, Roots).

 ancestor_tree(+Open, +Closed, +Targets, :Pred, +NodesIn, -NodesOut, -Roots) is det

Explore the ancestor graph one more step. This is the main loop looking for a spanning tree. We are done if

• There is only one open node left and no closed ones. We found the single common root.
• No open nodes are left. We have a set of closed roots which form our starting points. We still have to figure out the minimal set of these, as some of the trees may overlap others.
• We have an open node covering all targets. This is the lowest one as we used breath-first expansion. This step is too expensive.

  585ancestor_tree([One], [], _, _, Nodes, Nodes, [One]) :- !.
  586ancestor_tree([], Closed, _, _, Nodes, Nodes, Closed) :- !.
  587ancestor_tree(Open, _, Objects, _, Nodes, Nodes, [One]) :-
  588    member(One, Open),
  589    tree_covers(One, Nodes, Objects),
  590    !.
  591ancestor_tree(Open, Closed, Objects, Pred, Nodes0, Nodes, Roots) :-
  592    expand_ancestor_tree(Open, NewOpen, NewClosed, Closed, Nodes0, Nodes1, Pred),
  593    ancestor_tree(NewOpen, NewClosed, Objects, Pred, Nodes1, Nodes, Roots).

 expand_ancestor_tree(+Open0, -Open, +Closed0, -Closed, +Nodes0, -Nodes, :Pred)

Expand the explored graph with one level. Open are the currently open nodes. Closed are the nodes that have no parent and therefore are roots.

Arguments:

Nodes

- is an assoc R->(State*list(Child))

  607expand_ancestor_tree([], [], Closed, Closed, Nodes, Nodes, _).
  608expand_ancestor_tree([H|T], Open, Closed0, Closed, Nodes0, Nodes, Pred) :-
  609    setof(Parent, call(Pred, H, Parent), Parents),
  610    !,
  611    add_parents(Parents, H, Open, OpenT, Nodes0, Nodes1),
  612    expand_ancestor_tree(T, OpenT, Closed0, Closed, Nodes1, Nodes, Pred).
  613expand_ancestor_tree([H|T], Open, [H|ClosedT], Closed, Nodes0, Nodes, Pred) :-
  614    expand_ancestor_tree(T, Open, ClosedT, Closed, Nodes0, Nodes, Pred).

 add_parents(+Parents:list, +Child, -NR, +NRT, +Nodes0, -Nodes)

Add links Parent->Child to the tree Nodes0. The difference list NR\NRT contains Parents added new to the tree.

  622add_parents([], _, NP, NP, Nodes, Nodes).
  623add_parents([H|T], Child, NP, NPT, Nodes0, Nodes) :-
  624    in_tree(Child, H, Nodes0),
  625    !,
  626    add_parents(T, Child, NP, NPT, Nodes0, Nodes).
  627add_parents([H|T], Child, NP, NPT, Nodes0, Nodes) :-
  628    get_assoc(H,
  629              Nodes0, State*Children,
  630              Nodes1, State*[Child|Children]),
  631    !,
  632    add_parents(T, Child, NP, NPT, Nodes1, Nodes).
  633add_parents([H|T], Child, [H|NP], NPT, Nodes0, Nodes) :-
  634    put_assoc(H, Nodes0, node*[Child], Nodes1),
  635    add_parents(T, Child, NP, NPT, Nodes1, Nodes).

 in_tree(?Node, +Root, +Nodes) is nondet

True if Node appears in the tree below Root.

  642in_tree(Node, Node, _).
  643in_tree(Node, Root, Nodes) :-
  644    get_assoc(Root, Nodes, _State*Children),
  645    member(Child, Children),
  646    in_tree(Node, Child, Nodes).

 prune_forest(+Nodes, +Roots, -MinimalForest) is det

MinimalForest is the minimal forest overlapping all targets.

To be done

- Currently doesn't remove unnecessary trees.

  655prune_forest(Nodes, Roots, Forest) :-
  656    maplist(prune_root(Nodes), Roots, Roots1),
  657    sort(Roots1, Roots2),
  658    maplist(prune_ancestor_tree(Nodes), Roots2, Forest0),
  659    sort(Forest0, Forest).

 prune_root(+Nodes, +Root0, -Root) is det

Prune the parts of the search tree that ended up nowhere. The first real branch is where we find a solution or there are multiple parents. This avoids doing double work pruning the trees itself.

  668prune_root(Nodes, Root0, Root) :-
  669    get_assoc(Root0, Nodes, node*[One]),
  670    !,
  671    prune_root(Nodes, One, Root).
  672prune_root(_, Root, Root).

 prune_ancestor_tree(Nodes, Root, Tree) is det

Tree is a pruned hierarchy from Root using the branching paths of Nodes.

  679prune_ancestor_tree(Nodes, Root, Tree) :-
  680    get_assoc(Root, Nodes, Value),
  681    (   Value = node*[One]
  682    ->  prune_ancestor_tree(Nodes, One, Tree)
  683    ;   Tree = (Root-Children),
  684        Value = _*Children0,
  685        maplist(prune_ancestor_tree(Nodes), Children0, Children)
  686    ).

 tree_covers(+Root, +Nodes, -Targets:list) is det

True if Targets is the sorted list of targets covered by the tree for which Root is the root.

  693tree_covers(Root, Nodes, Targets) :-
  694    phrase(tree_covers(Root, Nodes), Targets0),
  695    sort(Targets0, Targets).
  696
  697tree_covers(Root, Nodes) -->
  698    { get_assoc(Root, Nodes, State*Children) },
  699    (   {State == target}
  700    ->  [Root]
  701    ;   []
  702    ),
  703    tree_covers_list(Children, Nodes).
  704
  705tree_covers_list([], _) -->
  706    [].
  707tree_covers_list([H|T], Nodes) -->
  708    tree_covers(H, Nodes),
  709    tree_covers_list(T, Nodes).
  710
  711
  712                 /*******************************
  713                 *          PRIMITIVES          *
  714                 *******************************/

 map_graph(+GraphIn, +Map:assoc, -GraphOut) is det

Map a graph to a new graph by mapping all fields of the RDF statements over Map. Then delete duplicates from the resulting graph as well as rdf(S,P,S) links that did not appear before the mapping.

To be done

- Should we look inside literals for mapped types? That would be consistent with abstract_graph/3.

  726map_graph(GraphIn, Map, GraphOut) :-
  727    phrase(map_triples(GraphIn, Map), Graph2),
  728    sort(Graph2, GraphOut).
  729
  730map_triples([], _) -->
  731    [].
  732map_triples([H0|T0], Map) -->
  733    map_triple(H0, Map),
  734    map_triples(T0, Map).
  735
  736map_triple(rdf(S0,P0,O0), Map) -->
  737    { map_resource(S0, Map, S),
  738      map_resource(P0, Map, P),
  739      map_object(O0, Map, O)
  740    },
  741    (   { S == O, S0 \== O0 }
  742    ->  []
  743    ;   [ rdf(S,P,O) ]
  744    ).
  745
  746map_resource(N0, Map, N) :-
  747    get_assoc(N0, Map, N),
  748    !.
  749map_resource(N, _, N).
  750
  751map_object(O0, Map, O) :-
  752    get_assoc(O0, Map, O),
  753    !.
  754map_object(literal(type(T0, V)), Map, L) :-
  755    get_assoc(T0, Map, T),
  756    !,
  757    L = literal(type(T, V)).
  758map_object(O, _, O).

 map_graph(+GraphIn, +Map:assoc, -GraphOut, -AbstractMap) is det

Map a graph to a new graph by mapping all fields of the RDF statements over Map. The nodes in these graphs are terms of the form Abstract-list(concrete).

Arguments:

AbstractMap

- assoc Abstract -> ordset(concrete)

  769map_graph(GraphIn, Map, GraphOut, AbstractMap) :-
  770    map_graph(GraphIn, Map, GraphOut),
  771    assoc_to_list(Map, ConcAbstr),  % Concrete->Abstract
  772    graph_nodes(GraphIn, AllConcrete),
  773    pairs_keys_intersection(ConcAbstr, AllConcrete, UsedConcAbstr),
  774    transpose_pairs(UsedConcAbstr, AbstrConc),
  775    group_pairs_by_key(AbstrConc, Grouped),
  776    list_to_assoc(Grouped, AbstractMap).

 pairs_keys_intersection(+Pairs, +Keys, -PairsInKeys) is det

True if PairsInKeys is a subset of Pairs whose key appear in Keys. Pairs must be key-sorted and Keys must be sorted. E.g.

?- pairs_keys_intersection([a-1,b-2,c-3], [a,c], X).
X = [a-1,c-3]

  789pairs_keys_intersection(Pairs, [K], Int) :-    % One key: happens quite often
  790    !,
  791    find_one_key(Pairs, K, Int).
  792pairs_keys_intersection([P1|TP], [K1|TK], Int) :-
  793    !,
  794    compare_pair_key(Diff, P1, K1),
  795    pairs_keys_isect(Diff, P1, TP, K1, TK, Int).
  796pairs_keys_intersection(_, _, []).
  797
  798pairs_keys_isect(<, _, [P1|TP], K1, TK, Int) :-
  799    !,
  800    compare_pair_key(Diff, P1, K1),
  801    pairs_keys_isect(Diff, P1, TP, K1, TK, Int).
  802pairs_keys_isect(=, P, [P1|TP], K1, TK, [P|Int]) :-
  803    !,
  804    compare_pair_key(Diff, P1, K1),
  805    pairs_keys_isect(Diff, P1, TP, K1, TK, Int).
  806pairs_keys_isect(>, P1, TP, _, [K1|TK], Int) :-
  807    !,
  808    compare_pair_key(Diff, P1, K1),
  809    pairs_keys_isect(Diff, P1, TP, K1, TK, Int).
  810pairs_keys_isect(=, P, _, _, _, [P]) :- !.
  811pairs_keys_isect(_, _, _, _, _, []).
  812
  813compare_pair_key(Order, K1-_, K2) :-
  814    !,
  815    compare(Order, K1, K2).
  816
  817find_one_key([], _, []).
  818find_one_key([K0-V|T0], K, List) :-
  819    (   K0 == K
  820    ->  List = [k0-V|T],
  821        find_one_key(T0, K, T)
  822    ;   find_one_key(T0, K, List)
  823    ).

 map_to_bagged_graph(+GraphIn, +Map, -GraphOut, -Bags) is det

GraphOut is a graph between objects and bags, using the most specific common ancestor for representing properties.

  831map_to_bagged_graph(GraphIn, Map, GraphOut, Bags) :-
  832    map_graph(GraphIn, Map, AbstractGraph, AbstractMap),
  833%   assertion(map_assoc(is_ordset, AbstractMap)),
  834    empty_assoc(Nodes),
  835    rdf_to_paired_graph(GraphIn, PairGraph),
  836    phrase(bagify_triples(AbstractGraph, PairGraph, AbstractMap,
  837                          Nodes, Bags, []),
  838           GraphOut).
  839
  840bagify_triples([], _, _, _, Bags, Bags) --> [].
  841bagify_triples([rdf(S0,_P,O0)|T], PairGraph, Map, Nodes, Bags, BagsT) -->
  842    { bagify_resource(S0, S, Map, Nodes, Nodes1, Bags, BagsT0),
  843      bagify_object(O0, O, Map, Nodes1, Nodes2, BagsT0, BagsT1),
  844
  845                                    % normal properties
  846      used_properties(S0, O0, PairGraph, Map, PList),
  847      common_ancestor_forest(sub_property_of, PList, Forest),
  848      debug(used_properties, 'Forest = ~p', [Forest]),
  849      pairs_keys(Forest, PRoots),
  850                                    % inverse properties
  851      used_properties(O0, S0, PairGraph, Map, IPList),
  852      common_ancestor_forest(sub_property_of, IPList, IForest),
  853      debug(used_properties, 'IForest = ~p', [IForest]),
  854      pairs_keys(IForest, IPRoots)
  855    },
  856    mk_p_triples(PRoots, S, O),
  857    mk_p_triples(IPRoots, O, S),
  858    bagify_triples(T, PairGraph, Map, Nodes2, BagsT1, BagsT).
  859
  860
  861bagify_resource(R0, R, _Map, Nodes, Nodes) -->
  862    { get_assoc(R0, Nodes, R) },
  863    !.
  864bagify_resource(R0, BagID, Map, Nodes0, Nodes) -->
  865    { get_assoc(R0, Map, Set), Set = [_,_|_],
  866      !,
  867      atom_concat('_:rbag_', R0, BagID),
  868      put_assoc(R0, Nodes0, BagID, Nodes)
  869    },
  870    make_rdf_graphs([BagID-Set]).
  871bagify_resource(R0, One, Map, Nodes, Nodes) -->
  872    { get_assoc(R0, Map, [One]) },
  873    !.
  874bagify_resource(R, R, _, Nodes, Nodes) --> [].
  875
  876bagify_object(R0, R, Map, Nodes0, Nodes) -->
  877    bagify_resource(R0, R, Map, Nodes0, Nodes).

 rdf_to_paired_graph(+GraphIn, -PairedGraph) is det

Arguments:

GraphIn	- Graph as list(rdf(S,P,O))
PairedGraph	- Graph as list(S-list(O-P)), where the pair lists are key-sorted,

  886rdf_to_paired_graph(Triples, Pairs) :-
  887    subject_pairs(Triples, Pairs0),
  888    keysort(Pairs0, Pairs1),
  889    group_pairs_by_key(Pairs1, Pairs2),
  890    maplist(keysort_values, Pairs2, Pairs).
  891
  892subject_pairs([], []).
  893subject_pairs([rdf(S,P,O)|T0], [S-(O-P)|T]) :-
  894    subject_pairs(T0, T).
  895
  896keysort_values(K-V0, K-V) :-
  897    keysort(V0, V).

 used_properties(+S0, +O0, +GraphIn, +AbstractMap, -PredList) is det

Find properties actually used between two bags. S0 and O0 are the subject and object from the abstract graph.

Arguments:

GraphIn	- original concrete graph represented as pairs. See rdf_to_paired_graph/2.
AbstractMap	- Assoc Abstract->Concrete, where Concrete is an ordset of resources.

  910used_properties(S0, O0, GraphIn, Map, PList) :-
  911    get_assoc(S0, Map, SList),
  912    get_assoc(O0, Map, OList),
  913    pairs_keys_intersection(GraphIn, SList, Intersection),
  914    pairs_values(Intersection, OPList0),
  915    append(OPList0, OPList1),
  916    keysort(OPList1, OPList),
  917    pairs_keys_intersection(OPList, OList, IntPList),
  918    pairs_values(IntPList, PListDupl),
  919    sort(PListDupl, PList),
  920    debug(used_properties, '  --> ~p', [PList]).

 graph_resources(+Graph, -Resources:list(atom)) is det

Resources is a sorted list of unique resources appearing in Graph. All resources are in Resources, regardless of the role played in the graph: node, edge (predicate) or type for a typed literal.

See also

- graph_resources/4 distinguishes the role of the resources.

  932graph_resources(Graph, Resources) :-
  933    graph_resources(Graph, R, P, P, T, T, [], _, _),
  934    sort(R, Resources).

 graph_nodes(+Graph, -Nodes) is det

Nodes is a sorted list of all resources and literals appearing in Graph.

To be done

- Better name

  943graph_nodes(Graph, Nodes) :-
  944    graph_resources(Graph, Nodes0, P, P, L, _, _, L, []),
  945    sort(Nodes0, Nodes).

 graph_resources(+Graph, -Resources:list(atom), -Predicates:list(atom), -Types:list(atom)) is det

Resources is a sorted list of unique resources appearing in Graph as subject or object of a triple. Predicates is a list of all unique predicates in Graph and Types is a list of all unique literal types in Graph.

  958graph_resources(Graph, Resources, Preds, Types) :-
  959    graph_resources(Graph, R, [], P, [], T, [], _, _),
  960    sort(R, Resources),
  961    sort(P, Preds),
  962    sort(T, Types).
  963
  964graph_resources([], R, R, P, P, T, T, L, L).
  965graph_resources([rdf(S,P,O)|T], [S|RT0], RT, [P|PTl0], PTl, Tl0, Tl, L0, L) :-
  966    object_resources(O, RT0, RT1, Tl0, Tl1, L0, L1),
  967    graph_resources(T, RT1, RT, PTl0, PTl, Tl1, Tl, L1, L).
  968
  969
  970object_resources(O, R0, R, T0, T, L0, L) :-
  971    (   atom(O)
  972    ->  R0 = [O|R], T0 = T, L0 = L
  973    ;   O = literal(Val)
  974    ->  R0 = R, L0 = [O|L],
  975        (   Val = type(Type, _)
  976        ->  T0 = [Type|T]
  977        ;   T0 = T
  978        )
  979    ;   assertion(fail)
  980    ).
  981
  982
  983                 /*******************************
  984                 *            ABSTRACT          *
  985                 *******************************/

 abstract_graph(+GraphIn, -GraphOut, +Options) is det

Unify GraphOut with an abstracted version of GraphIn. The abstraction is carried out triple-by-triple. Note there is no need to abstract all triples to the same level. We do however need to map nodes in the graph consistently. I.e. if we abstract the object of rdf(s,p,o), we must abstract the subject of rdf(o, p2, o2) to the same resource.

If we want to do incremental growing we must keep track which nodes where mapped to which resources. Option?

We must also decide on the abstraction level for a node. This can be based on the weight in the search graph, the involved properties and focus such as location and time. Should we express this focus in the weight?

Options:

map_in(?Map)

If present, this is the initial resource abstraction map.

map_out(-Map)

Provide access to the final resource abstraction map.

bags(-Bags)

If provided, bagify the graph, returning the triples that define the bags in Bags. The full graph is created by appending Bags to GraphOut.

merge_concepts_with_super(+Boolean)

If true (default), merge nodes of one is a super-concept of another.

 1018abstract_graph(GraphIn, GraphOut, Options) :-
 1019    map_in(Options, MapIn),
 1020    graph_resources(GraphIn, Nodes, NT, Edges, [], _T0, _TT, NT, []),
 1021    node_map(Nodes, MapIn, Map2, Options),
 1022    edge_map(Edges, Map2, MapOut),
 1023    map_out(Options, MapOut),
 1024    (   option(bags(Bags), Options)
 1025    ->  map_to_bagged_graph(GraphIn, MapOut, GraphOut, Bags)
 1026    ;   map_graph(GraphIn, MapOut, GraphOut)
 1027    ).
 1028
 1029map_in(Options, Map) :-
 1030    option(map_in(Map), Options, Map),
 1031    (var(Map) -> empty_assoc(Map) ; true).
 1032
 1033map_out(Options, Map) :-
 1034    option(map_out(Map), Options, _).

 node_map(+Nodes, +Map0, -Map, +Options) is det

Create the abstraction map for the nodes of the graph. It consists of two steps:

1. Map all instances to their class, except for concepts
2. If some instances are mapped to class A and others to class B, where A is a super-class of B, map all instances to class A.

 1046node_map(Nodes, Map0, Map, Options) :-
 1047    concepts_of(Nodes, Map0, Map1, _NewConcepts),
 1048    (   option(merge_concepts_with_super(true), Options, true)
 1049    ->  assoc_to_values(Map1, Concepts),
 1050        sort(Concepts, Unique),
 1051        identity_map(Unique, SuperMap0),
 1052        find_broaders(Unique, SuperMap0, SuperMap1),
 1053        deref_map(SuperMap1, SuperMap),
 1054        map_assoc(map_over(SuperMap), Map1, Map)
 1055    ;   Map = Map1
 1056    ).
 1057
 1058map_over(Map, V0, V) :-
 1059    (   get_assoc(V0, Map, V1)
 1060    ->  V = V1
 1061    ;   V = V0
 1062    ).
 1063
 1064concepts_of([], Map, Map, []).
 1065concepts_of([R|T], Map0, Map, New) :-
 1066    get_assoc(R, Map0, _),
 1067    !,
 1068    concepts_of(T, Map0, Map, New).
 1069concepts_of([R|T], Map0, Map, [C|New]) :-
 1070    concept_of(R, C),
 1071    put_assoc(R, Map0, C, Map1),
 1072    concepts_of(T, Map1, Map, New).

 identity_map(+List, -Map) is det

 find_broaders(+List, +Map0, -Map) is det

 deref_map(+Map0, -Map) is det

 1078identity_map(List, Map) :-
 1079    map_list_to_pairs(=, List, Pairs),
 1080    list_to_assoc(Pairs, Map).
 1081
 1082find_broaders([], Map, Map).
 1083find_broaders([C|T], Map0, Map) :-
 1084    broader(C, Super),
 1085    get_assoc(Super, Map0, SuperSuper),
 1086    !,
 1087    debug(rdf_abstract, 'Mapped ~p to super concept ~p', [C, SuperSuper]),
 1088    put_assoc(C, Map0, SuperSuper, Map1),
 1089    find_broaders(T, Map1, Map).
 1090find_broaders([_|T], Map0, Map) :-
 1091    find_broaders(T, Map0, Map).
 1092
 1093
 1094deref_map(Map0, Map) :-
 1095    findall(KV, mapped_kv(KV, Map0), Pairs),
 1096    deref(Pairs, NewPairs),
 1097    list_to_assoc(NewPairs, Map).
 1098
 1099mapped_kv(K-V, Assoc) :-
 1100    gen_assoc(K, Assoc, V),
 1101    K \== V.

 deref(+Pairs0, NewPairs) is det

Dereference chains V1-V2, V2-V3 into V1-V3, V2-V3. Note that Pairs0 may contain cycles, in which case all the members of the cycle are replaced by the representative as defined by rdf_representative/2.

 1110deref(Pairs, NewPairs) :-
 1111    list_to_assoc(Pairs, Assoc),
 1112    deref(Pairs, Assoc, NewPairs).
 1113
 1114deref([], _, []).
 1115deref([K-V0|T0], Map, [K-V|T]) :-
 1116    deref2(V0, Map, [V0], EqSet, V),
 1117    (   EqSet == []
 1118    ->  deref(T0, Map, T)
 1119    ;   rdf_representative(EqSet, V),
 1120        deref_cycle(T0, EqSet, V, Cycle, T1),
 1121        append(Cycle, T2, T),
 1122        deref(T1, Map, T2)
 1123    ).
 1124
 1125deref2(V0, Map, Visited, EqSet, V) :-
 1126    get_assoc(V0, Map, V1),
 1127    !,
 1128    (   memberchk(V1, Visited)
 1129    ->  EqSet = Visited
 1130    ;   deref2(V1, Map, [V1|Visited], EqSet, V)
 1131    ).
 1132deref2(V, _, _, [], V).
 1133
 1134deref_cycle([], _, _, [], []).
 1135deref_cycle([K-V0|T0], EqSet, V, [K-V|CT], Rest) :-
 1136    memberchk(V0, EqSet),
 1137    !,
 1138    deref_cycle(T0, EqSet, V, CT, Rest).
 1139deref_cycle([H|T0], EqSet, V, CT, [H|RT]) :-
 1140    deref_cycle(T0, EqSet, V, CT, RT).

 edge_map(+Edges, +MapIn, -MapOut) is det

 1145edge_map([], Map, Map).
 1146edge_map([R|T], Map0, Map) :-
 1147    get_assoc(R, Map0, _),
 1148    !,
 1149    edge_map(T, Map0, Map).
 1150%edge_map([R|T], Map0, Map) :-
 1151%       iface_abstract_predicate(R, C),
 1152%       put_assoc(R, Map0, C, Map1),
 1153%       edge_map(T, Map1, Map).

 concept_of(+Resource, -Concept) is det

True if Concept is the concept Resource belongs to. If Resource is a concept itself, Concept is Resource.

To be done

- Make thesaurus concept classes a subclass of skos:Class.

- Put in a reusable place, merge with kwd_search.pl

 1163concept_of(O, O) :-
 1164    rdfs_individual_of(O, skos:'Concept'),
 1165    !.
 1166concept_of(O, C) :-
 1167    rdf_has(O, rdf:type, C),
 1168    !.
 1169concept_of(O, O).

 broader(+Term, -Broader) is nondet

True if Broader is a broader term according to the SKOS schema.

To be done

- Deal with owl:sameAs (and skos:exactMatch)

 1177broader(Term, Broader) :-
 1178    rdf_reachable(Term, skos:broader, Broader),
 1179    Broader \== Term.

 rdf_representative(+Resources:list, -Representative:atom) is det

Representative is the most popular resource from the non-empty list Resources. The preferred representative is currently defined as the resource with the highest number of associated edges.

To be done

- Think about the function. Use sum of logs or sum of sqrt?

 1190rdf_representative(List, Representative) :-
 1191    (   exclude(rdf_is_bnode, List, NonBNodes),
 1192        NonBNodes \== []
 1193    ->  representative(NonBNodes, Representative)
 1194    ;   representative(List, Representative)
 1195    ).
 1196
 1197representative([H], Representative) :-
 1198    !,
 1199    Representative = H.
 1200representative([H|T], Representative) :-
 1201    fan_in_out(H, Fan0),
 1202    best(T, Fan0, H, Representative).
 1203
 1204best([], _, R, R).
 1205best([H|T], S0, R0, R) :-
 1206    fan_in_out(H, S1),
 1207    (   S1 > S0
 1208    ->  best(T, S1, H, R)
 1209    ;   best(T, S0, R0, R)
 1210    ).
 1211
 1212fan_in_out(R, Fan) :-
 1213    count(rdf(R, _, _), 100, FanOut),
 1214    count(rdf(_, _, R), 100, FanIn),
 1215    Fan is FanOut + FanIn.
 1216
 1217
 1218                 /*******************************
 1219                 *            SIMPLIFY          *
 1220                 *******************************/

 minimise_graph(+GraphIn, -GraphOut) is det

Remove redudant triples from a graph. Redundant triples are defined as:

• Super-properties of another property
• Inverse
• Symetric
• Entailed transitive

To be done

- Implement entailed transitive

 1234minimise_graph(RDF0, RDF) :-
 1235    partition(object_triple, RDF0, ObjRDF, LitRDF),
 1236    map_list_to_pairs(os_rdf, ObjRDF, Pairs),
 1237    group_pairs_by_key(Pairs, Grouped),
 1238    maplist(key_remove_reduntant_relations, Grouped, MinGroups),
 1239    append([LitRDF|MinGroups], RDF).
 1240
 1241object_triple(rdf(_,_,O)) :-
 1242    atom(O).
 1243
 1244os_rdf(rdf(S,_,O), (A+B)) :-
 1245    (   S @< O
 1246    ->  A = S, B = O
 1247    ;   A = O, B = S
 1248    ).
 1249
 1250key_remove_reduntant_relations(_-Rs0, Rs) :-
 1251    remove_reduntant_relations(Rs0, Rs).
 1252
 1253remove_reduntant_relations([R], [R]) :- !.
 1254remove_reduntant_relations(List0, List) :-
 1255    select(rdf(S,P1,O), List0, List1),
 1256    select(rdf(S,P2,O), List1, List2),
 1257    rdfs_subproperty_of(P1, P2),
 1258    !,
 1259    remove_reduntant_relations([rdf(S,P1,O)|List2], List).
 1260remove_reduntant_relations(List0, List) :-
 1261    select(rdf(S,P,O), List0, List1),
 1262    select(rdf(O,P,S), List1, List2),
 1263    rdfs_individual_of(P, owl:'SymmetricProperty'),
 1264    !,
 1265    remove_reduntant_relations([rdf(S,P,O)|List2], List).
 1266remove_reduntant_relations(List0, List) :-
 1267    select(rdf(S,P1,O), List0, List1),
 1268    select(rdf(O,P2,S), List1, List2),
 1269    rdf_has(P1, owl:inverseOf, P2),
 1270    !,
 1271    remove_reduntant_relations([rdf(S,P2,O)|List2], List).
 1272remove_reduntant_relations(List, List).
 1273
 1274
 1275                 /*******************************
 1276                 *              UTIL            *
 1277                 *******************************/
 1278
 1279:- meta_predicate
 1280    count(:, +, -). 1281
 1282count(G, Max, Count) :-
 1283    C = c(0),
 1284    (   G,
 1285        arg(1, C, C0),
 1286        C1 is C0+1,
 1287        nb_setarg(1, C, C1),
 1288        C1 == Max
 1289    ->  Count = Max
 1290    ;   arg(1, C, Count)
 1291    )