% ------------------------------------------------
% May 1999
% Author: Brian J Ross
% Dept. of Computer Science, Brock University, St Catharines, ON, Canada
% Please report errors to: bross@cosc.brocku.ca

% lamarckian_evolution v.2
% 
% Performs Lamarckian evolution on P% of population, iterating 
% each K times using hill climbing.
% lamarckian_P(P, K) is set by user. Population exists as facts in
% database of form: individual(ID, Fitness, Expression).
% Fitness is standardized (0 is best, higher values are less fit).
% An improved individual, if found, is replaced in the program database.
% First clause efficiently processes entire population.
% Second case is if less than entire population to be used, in which case
% selection must be performed.


lamarckian_evolution :-	
	lamarckian_P(Percent, K),
	Percent >= 1.0,
	setof(ID, F^E^individual(ID, F, E), IDs),
	write('Lamarckian evolution...'), nl,
	lamarck_loop(IDs, K),
	!.
lamarckian_evolution :-
	lamarckian_P(Percent, K),
	Percent > 0.0,
	Percent < 1.0,
	population_size_P(PopSize),
	N is integer(Percent * PopSize),
	write('Lamarckian evolution...'), nl,
	get_unique_IDs(N, [], IDs),
	lamarck_loop(IDs, K),
	!.
lamarckian_evolution.

% get_unique_IDs(N, SoFar, IDs)
%	N - Number of unique individual ID's to collect
%	SoFar - ID's collected so far
%	IDs - final set of unique IDs
%
% Retrieves a list of N unique individual ID's, 
% selecting each one via a tournament selection routine defined elsewhere.

get_unique_IDs(0, IDs, IDs) :- !.
get_unique_IDs(N, SoFar, IDs) :-
	repeat,  
	select(ID),
	\+ member(ID, SoFar),  
	M is N - 1,
	get_unique_IDs(M, [ID|SoFar], IDs),
	!.

% lamark_loop(IDs, Iter)
%	IDs - individuals to perform Lamarckian evolution upon
%	Iter - number of iterations for best-first search
%
% The individuals in IDs have hill climbing search performed on them.
% If the result of this search is a fitter individual, then that new
% individual replaces the origianl in the database. Side effect is that
% individual/3 clauses are replaced with improved individuals when found.
% Predicate also prints + and - characters to screen to give overview of
% Lamarckian performance.

lamarck_loop([], _) :- !.
lamarck_loop([ID|Rest], Iter) :-
	individual(ID, Fit, Expr),
	hillclimb(Iter, (Fit, Expr), (NewFit, NewExpr)),
	(NewFit >= Fit -> 
		write('-')
		;
		write('+'),
		retract(individual(ID, _, _)),  
		assert(individual(ID, NewFit, NewExpr))),
	lamarck_loop(Rest, Iter),
	!.

% hillclimb(K, Item, Soln) 
%	K - iterations to perform on individual for search
%	Item - best found so far
%	Soln - The most improved solution found. Worst case is an expression
%		having same fitness as original.
%
% Does hillclimbing search for K iterations on Item.  
% Itemx contains best expression obtained so far with mutation, 
% paired with its fitness. 

hillclimb(0, Item, Item) :- !.
hillclimb(K, (TopFit, TopExpr), Soln) :- 
	mutation(TopExpr, NewExpr),
	eval_fitness(NewExpr, NewFit),
	select_best((NewFit, NewExpr), (TopFit, TopExpr), BestSoFar),	
	K2 is K - 1,
	hillclimb(K2, BestSoFar, Soln),
	!.
hill_climb(K, BestSoFar, Soln) :-
	K2 is K - 1,
	hill_climb(K2, BestSoFar, Soln),
	!.

% select best of expression pairs

select_best((F1, E1), (F2, _), (F1, E1)) :- F1 =< F2, !.
select_best(_, X, X).


% etc...
member(A, [A|_]).
member(A, [_|B]) :- member(A, B).