1% ------------------------------------------------
    2% January 1999
    3% Author: Brian Ross
    4% Dept. of Computer Science, Brock University
    5%
    6% Fitness evaluation.
    7% 
    8% Evaluator/2 is user-supplied fitness function.
    9% It is then applied to initial population, which
   10% are reasserted with their fitness scores.
   11%
   12% The problem-specific evaluator should assign individuals a standardized
   13% fitness value (lower score is better, 0 is perfect). 
   14% It's syntax must be: evaluator(Expr, Val)
   15
   16
   17genesis :-
   18	population_size_P(InitPopSize, PopSize),
   19	ramped_population(InitPopSize),
   20	nl, evalInitialPopn,
   21	writel([nl, '*** Culling population', nl]),
   22	cull_population(InitPopSize, PopSize),
   23	collect_stats(0-culled),
   24	!.
   25
   26% following only used for initial population...
   27
   28evalInitialPopn :-
   29	retract(individual(ID, Fitness, Expression)),
   30	(var(Fitness) -> % only reevaluate if not scored 
   31		(eval_with_ID_P(yes) -> 
   32			evaluator(ID, Expression, Fitness)
   33			;
   34			evaluator(Expression, Fitness))
   35		;
   36		true),
   37	assertz(individual(ID, Fitness, Expression)),
   38	write('?'), ttyflush,
   39	fail.
   40evalInitialPopn :-
   41	collect_stats(0-genesis).
   42
   43cull_population(PopSize, PopSize) :- !.
   44cull_population(InitPopSize, PopSize) :-
   45	InitPopSize < PopSize,
   46	!,
   47	writel(['Error: init pop size ', InitPopSize, '< pop size', 
   48		 PopSize, nl]),
   49	fail.
   50cull_population(_, PopSize) :-
   51	cull_method_P(elite),
   52	!,
   53	write('Culling...'),nl,
   54	setof((V,K,E), individual(K,V,E), Set),
   55	first_K(0, PopSize, Set, Set2),
   56	retractall(individual(_,_,_)),
   57	assert_elite(Set2).
   58cull_population(CurrPopSize, PopSize) :-
   59	tournament_select(worst, CurrPopSize, ID, _),
   60	write('x'), ttyflush,
   61	retract(individual(ID, _, _)),
   62	(ID \== CurrPopSize ->
   63		retract(individual(CurrPopSize, Fit, Expr)),
   64		assert(individual(ID, Fit, Expr))
   65		;
   66		true),
   67	NewPopSize is CurrPopSize - 1,
   68	!,
   69	cull_population(NewPopSize, PopSize).
   70
   71% save best in run and best so far (session)
   72
   73set_best_in_run(Gen) :-
   74        bagof(V, E^ID^individual(ID, V, E), L),
   75	min_list(L, Min),
   76	best_in_run(_, BestSoFar, _),
   77	Min < BestSoFar,
   78	!,
   79	individual(_, Min, Expression),
   80	retract(best_in_run(_, _, _)),
   81	assert(best_in_run(Gen, Min, Expression)).
   82set_best_in_run(_).
   83
   84set_best_so_far(Run) :-
   85	best_in_run(Gen, Value, Expr),
   86	best_so_far(_, _, BV, _),
   87	Value < BV,
   88	!,
   89	retract(best_so_far(_, _, _, _)),
   90	assert(best_so_far(Run, Gen, Value, Expr)).
   91set_best_so_far(_).
   92
   93% assert_elite asserts individuals into population....
   94
   95assert_elite([]) :- !.
   96assert_elite([(V,K,E)|R]) :- 
   97	assert(individual(K,V,E)),
   98	assert_elite(R),
   99	!