1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3%       STATISTICS TOOLS FOR DEBUGGING 
    4%       Tested with ECLIPSE 5.3 and SWI Prolog over Linux RH 7.0-7.2
    5%
    6%	c) Sebastian Sardina      Many rights reserved		(Dec 2001)
    7%
    8%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    9%
   10% This library provides predicates to "inspect" where a Prolog program is 
   11% "spending" the execution time      
   12%
   13% This file provides:
   14%
   15%  -- callt(G,T): T is the time of executing T          */
   16%  -- callt(G)  : like callt/2 but the time is printed  */
   17%  -- dtime(L,G): ***main tool for debuging a program***
   18%                 Asserts a prediacte time(L,G,T) where T is the execution 
   19%                 time of goal G (sound only if no backtracking on G)  
   20%  -- collect_time: collects all time(L,G,T) with the same label L and asserts 
   21%                    predicate ttime(L,TT,N) where TT is the sum of
   22%                    all T's and N is the number of time/2 collected 
   23%                    (i.e, calls to G)  
   24%  -- showstat: print out statistics after the use of dtime/3     
   25%  -- showmax(L,G,T):- goal G of label L took the maximum time T
   26%  -- cleanstat: clean up all statistic information in the database
   27%
   28% The following predicates are required:
   29%  --- stime(T): returns system time T              
   30%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   31:-dynamic time/3,   % stores each goal call using a label
   32          ttime/3.  % stores the total time of a goal
   33                    % labeled and the no of times called
   34
   35% T is the time of calling G
   36callt(G,T):- stime(I), call(G), stime(E), T is E-I.
   37
   38% prints out the time of calling G
   39callt(G)  :- callt(G,T), nl, write('Time: '), write(T).
   40
   41% MAIN PREDICATE FOR DEBUGING
   42% Use in programs with a label to inspect how much time
   43% is spent in a section of a Prolog program
   44dtime(Label,Goal):- callt(Goal,T), assert(time(Label,Goal,T)).
   45
   46% Collect all time/2 into ttime/3 to state how much time
   47% per label and the number of calls 
   48collect_dtime:- setof(L,O^P^time(L,P,O),LL), member(ML,LL),
   49	        findall(T,time(ML,_,T),LTime), 
   50                length(LTime,NoCalls), sumup(LTime,TT), 
   51                assert(ttime(ML,TT,NoCalls)), fail.
   52collect_dtime.
   53
   54% After using dtime/2 in a program, collect total time
   55% per label using collect_dtime and prints out such data
   56cleanstat:- retractall(ttime(_,_,_)),  retractall(time(_,_,_)).
   57
   58showstat:- retractall(ttime(_,_,_)), once(collect_dtime), 
   59	   ttime(L,T,N), nl,
   60	   write('Label: '), write(L), 
   61           write(' Seconds: '), write(T),
   62	   write(' Times Called: '), write(N),
   63	   fail.
   64showstat.
   65
   66% Goal G of label L took the maximum time
   67showmax(L,G,T):- time(L,G,T), \+ (time(_,_,T2), T2>T).
   68	   
   69% Sum all numbers in a list of numbers
   70sumup([N],N).
   71sumup([N|L],T):- sumup(L,T2), T is T2+N