```    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,
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)```