1/* Part of dcgutils
    2	Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL)
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(dcg_progress, [
   20		seqmap_with_progress//3
   21	,	seqmap_with_progress//4
   22	,	stats/0
   23	,	stats/1
   24   ]).   25
   26:- meta_predicate
   27		seqmap_with_progress(+,3,+,?,?),
   28		seqmap_with_progress(+,4,+,?,?,?).
 seqmap_with_progress(+Period:natural, +Pred:pred(A,S,S), +X:list(A))// is nondet
 seqmap_with_progress(+Period:natural, +Pred:pred(A,B,S,S), +X:list(A), ?Y:list(B))// is nondet
Just like seqmap//2 and seqmap//3 but prints progress and memory usage statistics while running. Information is printed every Period iterations. The first input list must be valid list skeleton with a definite length, so that a percentage progress indicator can be printed.
   37seqmap_with_progress(E,P,X) --> {progress_init(E,X,Pr0)}, smp(X,P,Pr0).
   38seqmap_with_progress(E,P,X,Y) --> {progress_init(E,X,Pr0)}, smp(X,Y,P,Pr0).
   39
   40smp([],_,Pr) --> !, {progress_finish(Pr)}.
   41smp([X|XX],P,Pr1) --> {progress_next(Pr1,Pr2)}, call(P,X), !, smp(XX,P,Pr2).
   42
   43smp([],_,_,Pr) --> !, {progress_finish(Pr)}.
   44smp([X|XX],[Y|YY],P,Pr1) --> {progress_next(Pr1,Pr2)}, call(P,X,Y), !, smp(XX,YY,P,Pr2).
   45
   46
   47progress_init(E,X,pr(T0,T,E,0,0)) :- length(X,T), get_time(T0).
   48progress_finish(Pr) :-
   49	progress_next(Pr,_),
   50	get_time(T1), Pr=pr(T0,N,_,_,_), 
   51	format('\nFinished ~w items in ~3g minutes.\n',[N,(T1-T0)/60]).
   52
   53progress_next(pr(T0,Total,E,N,E),pr(T0,Total,E,M,1)) :- !, 
   54	succ(N,M),
   55	stats(Codes),
   56	get_time(T1), 
   57	format('~s | done ~0f% in ~3g s    \r', [Codes,100*N/Total,T1-T0]),
   58	flush_output.
   59
   60progress_next(pr(T0,T,E,N,C),pr(T0,T,E,M,D)) :- succ(C,D), succ(N,M).
 stats is det
Print memory usage statistics.
   66stats :- !, 
   67	stats(Codes),
   68	format('~s\r',[Codes]),
   69	flush_output.
 stats(-Codes:list(code)) is det
Return memory usage statistics as a list of codes.
   74stats(Codes) :- !, 
   75	statistics(heapused,Heap),
   76	statistics(localused,Local),
   77	statistics(globalused,Global),
   78	statistics(trailused,Trail),
   79	format(codes(Codes), 'heap: ~t~D ~18| local: ~t~D ~36| global: ~t~D ~57| trail: ~t~D ~77|',
   80		[Heap,Local,Global,Trail])