1% ------------------------------------------------
    2% Jan 1999
    3% Author: Brian Ross
    4% Dept. of Computer Science, Brock University
    5%
    6% Statistics and I/O
    7
    8:- expects_dialect(sicstus).    9:- use_module(library(dialect/sicstus/system)).   10
   11print_tourn_stats(Gen) :-
   12	collect_stats(Gen), % should replace with param passing
   13	gp_stats(Gen, Time, Best, Worst, Avg, AvgD, Lamarck),   
   14	(var(Lamarck) -> Lamarck = lamarck(0,0,0) ; true),
   15	print_stat(Gen, Time, Best, Worst, Avg, AvgD, Lamarck),
   16	(popn_dump_P(yes) -> dump_population(Gen) ; true),
   17	!.
   18
   19% collect_stats computes some statistics. gp_stats might already be
   20% asserted for generation by Lamarckian evol routine, if used. Retract it,
   21% but retain it's stat.
   22
   23collect_stats(Gen) :-
   24	bagof(V, E^ID^individual(ID, V, E), L),
   25	size_of(L, N),
   26	sum_list(L, Sum),
   27	max_list(L, Max),
   28	bagof(ID, E^individual(ID, Max, E), WL),
   29	length(WL, SizeW),
   30	min_list(L, Min),
   31	individual(_, Min, Bexpr),
   32	bagof(ID, E^individual(ID, Min, E), BL),
   33	length(BL, SizeB),
   34	Avg is Sum / N,
   35	bagof(D, ID^VV^E^(individual(ID, VV, E),tree_depth(E,D)), M),
   36	average(M, AvgDepth),
   37	%time_stamp('%h:%02i:%02s%a',T),
   38	% datime(datime(_,_,_,Hour,Minute,Sec)),
   39        since_last_datime(total,call,HourT,MinuteT,SecT),
   40        since_last_datime(generation,retract,Hour,Minute,Sec),
   41	(retract(gp_stats(Gen,_,_,_,_,_,_,Lamarck)) ; true),
   42	assertz(gp_stats(Gen,Hour:Minute:Sec/HourT:MinuteT:SecT, best(Min, SizeB, Bexpr),
   43			 worst(Max, SizeW),avg(Avg),AvgDepth,Lamarck)),
   44	!.
   45
   46since_last_datime(For,SetReset,Hour,Minute,Sec):- 
   47   once(call(SetReset,got_time(For,Was));Was=0),
   48   get_time(Now),
   49   DiffTime is Now - Was,
   50   (SetReset==retract -> asserta(got_time(For,Now)) ; true),
   51   stamp_date_time(DiffTime, date(_Year,_Month,_Day,Hour,Minute,Sec,_,_,_), 'UTC'),!.
   52
   53:- dynamic(got_time/2).   54:- get_time(Now),asserta(got_time(total,Now)),asserta(got_time(total,Now)).   55
   56% print run statistics
   57dump_stats(Run) :-
   58	wd_P(Dir),   % Windows
   59	working_directory(_,Dir), % Windows
   60	set_file_name("stats", Run, File),
   61	tell(File),	
   62	%once(time_stamp('Date: %W, %d %M %y    Time: %c:%02i%a', DateTime)),
   63        since_last_datime(total,retract,Hour,Min,Sec),	
   64        datime(datime(Year,Month,Day,_DA_Hour,_DA_Min,_DA_Sec)),
   65	writel([nl,nl,'***** Summary statistics: Run ', Run, ' *****',nl,nl,
   66		(Year-Month-Day-Hour:Min:Sec), nl, nl]),
   67	gp_stats(Gen, Time, Best, Worst, Avg, AvgDepth, Lamarck), % loops for all
   68	(var(Lamarck) -> Lamarck = lamarck(0,0,0) ; true),
   69	print_stat(Gen, Time, Best, Worst, Avg, AvgDepth,  Lamarck),
   70	fail.				   % loop driver
   71dump_stats(Run) :-
   72	nl, nl,
   73	% from gp_parameters file... 
   74	population_size_P(InitPopSize, PopSize),
   75	max_runs_P(MaxRun, RunSoln, MaxGen),
   76	prob_crossover_P(PC),
   77	%crossover_P(PIC, PTC),
   78	prob_internal_crossover_P(PIC),
   79	prob_terminal_mutation_P(PTM),
   80	max_depth_P(DepthInit, DepthCross),
   81	error_tolerance_P(Err),
   82	fitness_func_P(FitFile),
   83	dctg_file_P(FileDCTG),
   84	evaluator_reset_P(EvalReset, N),
   85	gen_type_P(GenType),
   86	best_in_run(Bgen, Fitness, Expr),  
   87	count_nodes(Expr, all, ENodeCnt),
   88	tree_depth(Expr, Edepth),
   89	tournament_size_P(TS, TR),
   90	lamarckian_P(LP, LK, Lsel, LCross),
   91	unique_population_P(Unique),
   92	%rep_limit_P(Rep),
   93	seed_P(RanMode, Y),
   94	% some other stats...
   95	min_grammar_prob_P(MinProb),
   96	gen_set_size_P(GenSet),
   97	sre_mintestcnt_P(Mintst),
   98	%sre_mutation_P(SREmut),
   99	%mutation_range_P(Mutrange),
  100	max_string_length_P(Maxstr),
  101	writel([nl,'Best Soln:', Expr,nl]),
  102	Expr^^construct(E), write('Expression: '),sre_pp(E), nl,
  103	writel(['found at generation ', Bgen,nl,
  104		'Soln # nodes:', ENodeCnt,nl,
  105		'Soln depth:', Edepth,nl,
  106		'Soln Fitness = ', Fitness,nl]),
  107	(gp_stats(MaxGen,_, best(MinLast, _, BexprLast), _, _, _, _) ->
  108		count_nodes(BexprLast, all, ENodeCntLast),
  109		tree_depth(BexprLast, EdepthLast),
  110		writel([nl,'Best Last Gen', MaxGen, ': ', BexprLast,nl]),
  111		BexprLast^^construct(ELast), write('Expression: '),sre_pp(ELast), nl,
  112		writel(['Last # nodes:', ENodeCntLast,nl,
  113			'Last depth:', EdepthLast,nl,
  114			'Last Fitness = ', MinLast,nl])
  115		;
  116		true), % if last generation never reached (soln found before)
  117	writel(['-------',nl,
  118		'Fitness func file:', FitFile, nl,
  119		'DCTG file:', FileDCTG, nl,
  120		'Evaluator reset:', EvalReset, ' N:', N, nl,
  121		'Generation type:', GenType, nl,
  122		'Init pop size = ', InitPopSize, nl,
  123		'Pop size = ', PopSize, nl,
  124		'Max runs = ', MaxRun, ', ', RunSoln, nl,
  125		'Max gen = ', MaxGen, nl,
  126		'Prob crossover = ', PC, nl,
  127		'Prob int cross = ', PIC, nl,
  128		'Prob term mutation = ', PTM, nl,
  129		'Tournament size: sel = ', TS, ' repl = ', TR, nl,
  130		'Lamarckian: ', LP, 'of popn, iterate = ', LK, ', select = ', Lsel, ', Prob Cross=', LCross, nl,
  131		'Unique popn = ', Unique, nl,
  132		'Random seed:', RanMode, ', Y=',Y, nl,
  133		'Max depth init = ', DepthInit, nl,
  134		'Max depth crossover = ', DepthCross, nl,
  135		'Initial test set size =', GenSet, nl,
  136		'Max test set string length =', Maxstr, nl,
  137		'Minimum test set count =', Mintst, nl,
  138		'Min grammar probability =',MinProb, nl,
  139		%'SRE numeric mutation rate =', SREmut, nl,
  140		%'SRE mutation range = +/-',Mutrange,nl,
  141		'Error tolerance = ', Err, nl]),
  142	%write('Best...'), nl, dna_summary(Expr),   % for DNA only
  143	%write('Best optimized...'), nl, 
  144	%mask_optimize(Expr, Fitness, ExprOpt),
  145	%dna_summary(ExprOpt),   % for DNA only
  146	/*
  147	(gp_stats(MaxGen,_, best(MinLast, _, BexprLast), _, _, _, _) ->
  148		write('Last...'), nl, 
  149		dna_summary(BexprLast),
  150		mask_optimize(BexprLast, MinLast, LastOpt),   % for DNA only
  151		write('Last optimized...'), nl,
  152		dna_summary(LastOpt)
  153		;
  154		true),
  155	*/
  156	writel(['*** End of Run ', Run, ' ***',nl]),
  157	told, tell(user),
  158	write_soln("soln", Run, Expr).  % <-- new.
  159	%write_soln("solnopt", Run, ExprOpt).  % <-- new.
  160	/*
  161	(gp_stats(MaxGen,_, best(MinLast, _, BexprLast), _, _, _, _) ->
  162		write_soln("last", Run, BexprLast), % <-- new
  163		write_soln("lastopt", Run, LastOpt)  
  164		;
  165		true).
  166	*/
  167	% dump_population(Run).
  168
  169set_file_name(RootName, Run, File) :-
  170	append(RootName, "-", File0),
  171	name(Run, File1),
  172	append(File0, File1, File2),
  173	%once(time_stamp('.%d%02n%02y-%02c%02i', Name3)),
  174	%name(Name3, File3),
  175	datime(datime(Year,Month,Day,Hour,Min,Sec)),
  176	name(Year, N1),
  177	name(Month, N2),
  178	name(Day, N3),
  179	name(Hour, N4),
  180	name(Min, N5),
  181	name(Sec, N6),
  182	append(N3, N2, N1a),
  183	append(N1a, N1, N1b),
  184	append(N1b, "-", N1c),
  185	append(N1c, N4, N1d),
  186	append(N1d, N5, N1e),
  187	append(N1e, N6, File3),
  188	append(File2, File3, File4),
  189	append(File4,".txt",File5),
  190	name(File, File5),
  191	!.
  192
  193print_stat(Gen, Time, best(Bfit, Bcount, Bexpr), worst(Wfit, Wcount), 
  194		avg(Avg), AvgD, _) :-
  195	lamarckian_P(0.0, _, _, _),
  196	!,
  197	writel([nl,nl, '---> Generation ', Gen, '(', Time, ')', nl,
  198	        'Average fitness:', Avg, nl,
  199	        'Best count: ', Bcount, nl,
  200	        'Best example:', Bexpr, nl,
  201	        'Best fitness = ', Bfit, nl,
  202	        'Worst count: ', Wcount, nl,
  203	        'Worst fitness = ', Wfit, nl,
  204	        'Average Depth:', AvgD, nl,
  205		'Lamarckian evolution: off ',nl,nl]),
  206	!.
  207print_stat(Gen, Time, best(Bfit, Bcount, Bexpr), worst(Wfit, Wcount), 
  208		avg(Avg), AvgD, lamarck(FitImpr,MaxImpr,NumGain)) :-
  209	lamarckian_P(Percent, _, _, _),
  210	population_size_P(_, PopSize),
  211	N is integer(Percent * PopSize),
  212	(NumGain > 0 -> AvgLam is FitImpr/NumGain ; AvgLam=0),
  213	writel([nl,nl, '---> Generation ', Gen, '(', Time, ')', nl,
  214	        'Average fitness:', Avg, nl,
  215	        'Best count: ', Bcount, nl,
  216	        'Best example:', Bexpr, nl,
  217	        'Best fitness = ', Bfit, nl,
  218	        'Worst count: ', Wcount, nl,
  219	        'Worst fitness = ', Wfit, nl,
  220	        'Average Depth:', AvgD, nl,
  221		'Lamarckian evolution: ', nl,
  222		'    ', NumGain, ' gains out of ', N,' tries', nl,
  223		'    Total gain:', FitImpr, nl,
  224		'    Max single gain:', MaxImpr, nl,
  225		'    Avg gain:', AvgLam, nl, nl]),
  226	!.
  227
  228% print existing population
  229
  230dump_population(Run) :-
  231	set_file_name("popn", Run, File),
  232	tell(File),
  233	individual(ID, V, Expr),
  234	write_individual(ID, V, Expr),
  235	fail.
  236dump_population(_) :-
  237	told, tell(user).
  238
  239write_individual(ID, V, Expr) :-
  240	writel(['-----', nl,
  241		'Individual ', ID, ': fit=', V, nl, Expr, nl]),
  242	Expr^^construct(E), 
  243	sre_pp(E), nl,
  244	!.
  245
  246% ------------------------------------
  247% solution dump: writes soln expression to a file, for input later.
  248% Grammatical expression is written in multiple lines, since the full
  249% expression is often larger than Prolog's builtin "write" can handle.
  250
  251write_soln(Name, Run, E) :-
  252	set_file_name(Name, Run, File),
  253	tell(File),
  254	write('soln('),
  255	write_term(E),
  256	write(').'),
  257	nl,
  258	told,
  259	tell(user),
  260	!.
  261
  262write_term(node(X,List,Y)) :-
  263	!,
  264	write('node('),
  265	write(X),
  266	write(',['),
  267	write_tlist(List),
  268	write('],'),
  269	write(Y),
  270	write(')').
  271write_term(X) :- write(X).
  272
  273write_tlist([]) :- !.
  274write_tlist([X,Y|Z]) :-
  275	!,
  276	write_term(X),
  277	write(','),
  278	nl,
  279	write_tlist([Y|Z]).
  280write_tlist([X]) :-
  281	write_term(X)