1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: G�nter Kniesel (among others)
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15% Date:   12.06.2004
   16
   17/* ***********************************************************
   18 * Different semantic and implementation variants of counting:
   19 *  - Semantic: Counting derivations (success) versus results.
   20 *  - Implementation: Based on nb_setargs/3, flag/3 or findall/3.
   21 * *********************************************************** */
   22:- module(count, [
   23	count_facts/2,
   24	count_success/2,
   25	count/2,
   26	count_and_print/2,
   27	count_unique/3,
   28	count_all_and_unique/3
   29]).   30
   31:- use_module(library(lists)).   32 
   33count_facts(Goal, Nr) :-
   34  predicate_property(Goal, number_of_clauses(Nr)).
   35
   36:- meta_predicate count_success(0, -).     
   37                                    
   38count_success(Goal, Times) :-    
   39        Counter = counter(0),       
   40        (   catch(Goal,_,fail),                   
   41                 arg(1, Counter, N0),    
   42                 N is N0 + 1,            
   43                 nb_setarg(1, Counter, N),   
   44            fail                    
   45        ;   arg(1, Counter, Times)  
   46        ).        
   47  
   48:- module_transparent count/2.   49
   50count(Goal, _) :-
   51	nb_setval(successcounter, 0),
   52    catch(Goal,_Any,fail),     % turn exceptions into failures
   53    nb_getval(successcounter, N),
   54    N2 is N + 1,
   55    nb_setval(successcounter,N2),
   56    fail.
   57    
   58count(_, N) :-
   59	nb_getval(successcounter, N).
   60  
   61%count(Goal, _) :-
   62%  flag(successcounter,_,0),
   63%  catch(Goal,_Any,fail),     % turn exceptions into failures
   64%    flag(successcounter,N,N+1),
   65%  fail.
   66%count(_, N) :-
   67%  flag(successcounter,N,N).
   68
   69
   70:- module_transparent count_and_print/2.   71
   72count_and_print(Goal, _) :-
   73  nb_setval(successcounter,0),
   74  catch(Goal,_Any,fail),     % turn exceptions into failures
   75    nb_getval(successcounter,N),
   76    N2 is N + 1,
   77    nb_setval(successcounter,N2),
   78    format('~w.~n', [Goal]),
   79  fail.
   80count_and_print(_, N) :-
   81  nb_getval(successcounter,N).
   82  
   83  
   84:- module_transparent count_unique/2.   85
   86count_unique(Goal,Nall,Nunique) :-
   87  findall(Goal, catch(Goal,_Any,fail), All),    % turn exceptions into failures
   88  sort(All,Unique),
   89  length(All,Nall),
   90  length(Unique,Nunique).
   91
   92/*
   93?- count(create_generic_edges:parent(Id,EdgeVal,NodeType,TargetType),N).
   94N = 70894 ;
   95
   96?- count( (ast_node_type_dummy(Id,Type), not( create_generic_edges:parent(Id, EdgeVal, Type, TargetType) )),N).
   97N = 29742 ;
   98
   99?- X is 29742 + 70894.
  100
  101X = 100636 
  102
  103?- count( ast_node_type_dummy(_,_) , N).
  104N = 100636 ;
  105*/
  106
  107
  108/* ***************************************************************
  109   Findall-based counting. 
  110   ***************************************************************
  111   Inappropriate for large factbases but useful for counting
  112   but useful for counting without duplicates -- which is 
  113   currently not supported by count/2, count_facts/2 above.
  114*/
  115
  116/* *
  117 * count_all_and_unique(+Goal,Nall,Nunique)
  118 *   Find all results and all unique results as lists and count
  119 *   them using count_list_elements.
  120 */
  121% Count exceptions as failures:
  122:- module_transparent count_unique/2.  123
  124count_all_and_unique(Goal,Nall,Nunique) :-
  125  findall(Goal, catch(Goal,_Any,fail), All),  
  126  count_list_elements(All,_SortedUnique,Nall,Nunique).
  127
  128
  129/*
  130 * count_list_elements(+All,?SortedUnique,?LengthAll,?LengthSortedUnique)
  131 *   Return sorted, duplicate-free list and lenght of both lists.
  132 */   
  133count_list_elements(All,SortedUnique,LengthAll,LengthSortedUnique) :-
  134  sort(All,SortedUnique),
  135  length(All,LengthAll),
  136  length(SortedUnique,LengthSortedUnique).
  137  
  138/* ********************************************************** 
  139   Experimental stuff, for grouping before counting. Useful
  140   for instance, for determining singular groups,  
  141*/
  142   
  143
  144/* *
  145 * group_by(+Other, +Goal, ?OtherVals)
  146 *   Other is a term containing variables of Goal whose 
  147 *   values we want to determine. OtherVals will contain
  148 *   one instance of Other for each group of same values
  149 *   for the remaining variables og Goal.
  150 */ 
  151group_by(Other, Goal, OtherVals) :-
  152    bagof(Other, call(Goal), OtherVals )