View source with raw comments or as raw
    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(count,
   37          [ proof_count/2,              % :Goal, -Count
   38            proof_count/3,              % :Goal, +Max, -Count
   39            answer_count/3,             % ?Var, :Goal, -Count
   40            answer_count/4,             % ?Var, :Goal, +Max -Count
   41            answer_set/3,               % ?Var, :Goal, -Answers
   42            answer_set/4,               % ?Var, :Goal, +Max, -Answers
   43            answer_pair_set/5,          % ?Pair, :Goal, +MaxKeys, +MaxPerKey, -Answers
   44            unique_solution/2           % :Goal, -Solution
   45          ]).   46:- use_module(library(nb_set)).   47:- use_module(library(rbtrees)).   48:- use_module(library(nb_rbtrees)).

This module provides various ways to count solutions

This module is based on a similar collection introduces in the first ClioPatria release. Most names have been changed to describe the semantics more accurately.

The predicates in this library provide space-efficient solutions, avoiding findall/setof. Most predicates come with a variant that allows limiting the number of answers.

To be done
- The current implementation is often based on library(nb_set), which implements unbalanced binary trees. We should either provide a balanced version or use Paul Tarau's interactors to solve these problems without destructive datastructures. */
   67:- meta_predicate
   68    proof_count(0, -),
   69    proof_count(0, +, -),
   70    answer_count(?, 0, -),
   71    answer_count(?, 0, +, -),
   72    answer_set(?, 0, -),
   73    answer_set(?, 0, +, -),
   74    answer_pair_set(?, 0, +, +, -),
   75    unique_solution(0, -).
 proof_count(:Goal, -Count) is det
 proof_count(:Goal, +Max, -Count) is det
True if Count is the number of times Goal succeeds. Note that this is not the same as the number of answers. E.g, repeat/0 has infinite proofs that all have the same -empty- answer substitution.
See also
- answer_count/3
   87proof_count(Goal, Count) :-
   88    proof_count(Goal, infinite, Count).
   89
   90proof_count(Goal, Max, Count) :-
   91    State = count(0),
   92    (   Goal,
   93        arg(1, State, N0),
   94        N is N0 + 1,
   95        nb_setarg(1, State, N),
   96        N == Max
   97    ->  Count = Max
   98    ;   arg(1, State, Count)
   99    ).
 answer_count(?Var, :Goal, -Count) is det
 answer_count(?Var, :Goal, +Max, -Count) is det
Count number of unique answers of Var Goal produces. Enumeration stops if Max solutions have been found, unifying Count to Max.
  107answer_count(T, G, Count) :-
  108    answer_count(T, G, infinite, Count).
  109
  110answer_count(T, G, Max, Count) :-
  111    empty_nb_set(Set),
  112    C = c(0),
  113    (   G,
  114        add_nb_set(T, Set, true),
  115        arg(1, C, C0),
  116        C1 is C0+1,
  117        nb_setarg(1, C, C1),
  118        C1 == Max
  119    ->  Count = Max
  120    ;   arg(1, C, Count)
  121    ).
 answer_set(?Var, :Goal, -SortedSet) is det
 answer_set(?Var, :Goal, +MaxResults, -SortedSet) is det
SortedSet is the set of bindings for Var for which Goal is true. The predicate answer_set/3 is the same as findall/3 followed by sort/2. The predicate answer_set/4 limits the result to the first MaxResults. Note that this is not the same as the first MaxResults from the entire answer set, which would require computing the entire set.
  133answer_set(T, G, Ts) :-
  134    findall(T, G, Raw),
  135    sort(Raw, Ts).
  136
  137answer_set(T, G, Max, Ts) :-
  138    empty_nb_set(Set),
  139    State = count(0),
  140    (   G,
  141        add_nb_set(T, Set, true),
  142        arg(1, State, C0),
  143        C is C0 + 1,
  144        nb_setarg(1, State, C),
  145        C == Max
  146    ->  true
  147    ;   true
  148    ),
  149    nb_set_to_list(Set, Ts).
 answer_pair_set(Var, :Goal, +MaxKeys, +MaxPerKey, -Group)
Bounded find of Key-Value pairs. MaxKeys bounds the maximum number of keys. MaxPerKey bounds the maximum number of answers per key.
  157answer_pair_set(P, G, MaxKeys, MaxPerKey, Groups) :-
  158    P = K-V,
  159    (   MaxPerKey = inf
  160    ->  true
  161    ;   TooMany is MaxPerKey+1,
  162        dif(New, values(TooMany))
  163    ),
  164    rb_empty(Tree),
  165    State = keys(0),
  166    (   G,
  167        add_pair(Tree, K, V, New),
  168        New == new_key,
  169        arg(1, State, C0),
  170        C is C0+1,
  171        nb_setarg(1, State, C),
  172        C == MaxKeys
  173    ->  true
  174    ;   true
  175    ),
  176    groups(Tree, Groups).
  177
  178add_pair(T, K, V, New) :-
  179    nb_rb_get_node(T, K, N),
  180    !,
  181    nb_rb_node_value(N, NV),
  182    NV = k(Count, VT),
  183    (   nb_rb_get_node(VT, V, _)
  184    ->  New = false
  185    ;   NewCount is Count + 1,
  186        New = values(NewCount),
  187        nb_rb_insert(VT, V, true),
  188        nb_setarg(1, NV, NewCount)
  189    ).
  190add_pair(T, K, V, new_key) :-
  191    rb_one(V, true, RB),
  192    nb_rb_insert(T, K, k(1, RB)).
  193
  194rb_one(K, V, Tree) :-
  195    rb_empty(T0),
  196    rb_insert(T0, K, V, Tree).
  197
  198groups(Tree, Groups) :-
  199    rb_visit(Tree, Pairs),
  200    maplist(expand_values, Pairs, Groups).
  201
  202expand_values(K-k(_Count,T), K-Vs) :-
  203    rb_keys(T, Vs).
 unique_solution(:Goal, -Solution) is semidet
True if Goal produces exactly one solution for Var. Multiple solutions are compared using =@=/2. This is semantically the same as the code below, but fails early if a second nonequal solution for Var is found.
findall(Var, Goal, Solutions), sort(Solutions, [Solution]).
  216unique_solution(Goal, Solution) :-
  217    State = state(false, _),
  218    (   Goal,
  219        (   arg(1, State, false)
  220        ->  nb_setarg(1, State, true),
  221            nb_setarg(2, State, Solution),
  222            fail
  223        ;   arg(2, State, Answer),
  224            Answer =@= Solution
  225        ->  fail
  226        ;   !, fail                         % multiple answers
  227        )
  228    ;   arg(1, State, true),
  229        arg(2, State, Solution)
  230    )