<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">%
%                      Genetic Programming in Prolog
%                The Logical Solution to Genetic Algorithms
%
%                     Copyright (c) 1993  Simon Raik
%
%                            Date: July 5, 1993.

%
% Genetic Parameters
%
population_size(10).				% Number of individuals in population
maximum_generations(20).			% number of generations to perform
maximum_initial_depth(4).			% max initial depth of genetic programs
maximum_depth_after_crossover(15).	% like it says...
maximum_actions(30).				% Number of actions each individual is
									% allowed to perform in a life time.
grid_size(10).

% Dubbugging?
debug_on(off).

debug_info(Message) :-
	debug_on(on),
	write(Message), nl.
debug_info(_).


% Function &amp; Terminal declarations
terminals([turn_left, turn_right, advance]).
functions([begin, if_sensor]).

%
% Terminals	Set
%
turn_left(Who) :-
	debug_info(turn_left),
	write('.'),
	
	% increment the action counter
	actions(Actions),
	Num is Actions + 1,
	retract(actions(Actions)),
	assert(actions(Num)),
	
	direction(Who, X),
	retract(direction(Who, X)),
	New is (X - 1) mod 4,	
	assert(direction(Who, New)).
	
turn_right(Who) :- 
	debug_info(turn_right),
	write('.'),
	
	% increment the action counter
	actions(Actions),
	Num is Actions + 1,
	retract(actions(Actions)),
	assert(actions(Num)),
	
	direction(Who, X),
	retract(direction(Who, X)),
	New is (X + 1) mod 4,	
	assert(direction(Who, New)).

advance(Who) :-
	debug_info(advance),
	write('.'),
	
	% increment the action counter
	actions(Actions),
	Num is Actions + 1,
	retract(actions(Actions)),
	assert(actions(Num)),

	% Move in the direction facing.
	direction(Who, Direction),
	adjustment(Direction, X, Y),
	x_pos(Who, OldX),
	y_pos(Who, OldY),
	
	grid_size(Grid),
	NewX is (OldX + X) mod Grid,
	NewY is (OldY + Y) mod Grid,
	   	
	% Debug
	debug_info('Direction: '), 
	debug_info(Direction),
	debug_info('Old X: '), 
	debug_info(OldX), 
	debug_info(' Y: '), 
	debug_info(OldY),
	debug_info('New X: '), 
	debug_info(NewX), 
	debug_info(' Y: '), 
	debug_info(NewY),
	 
	% Replace the new info into the database.
	retract(x_pos(Who, OldX)),
	retract(y_pos(Who, OldY)),
	assert(x_pos(Who, NewX)),
	assert(y_pos(Who, NewY)),
	
	possible_crumb(Who).

possible_crumb(Who) :-
	x_pos(Who, X),
	y_pos(Who, Y),
	
	% check if there is a crumb there.
	crumb(Who, X, Y),!,

	% Add to the fitness
	fitness(Who, Fitness),
	retract(fitness(Who, Fitness)),
	NewFitness is Fitness + 1,
	assert(fitness(Who, NewFitness)),
	
	% remove the crumb.
	retract(crumb(Who, X, Y)).

possible_crumb(_).
	
%
% Functions Set
%
begin. % No definition required,

% Returns true or false.
if_sensor(Who) :-
	% Check for the presence of a crumb in the direction facing.
	direction(Who, Direction),
	adjustment(Direction, X, Y),
	x_pos(Who, OldX),
	y_pos(Who, OldY),
	
	grid_size(Grid),
	NewX is OldX + X mod Grid,
	NewY is OldY + Y mod Grid,
	
	crumb(Who, NewX, NewY).

% Directional adjustment for x &amp; y values.	
adjustment(0,  0,  1).
adjustment(1,  1,  0).
adjustment(2,  0, -1).
adjustment(3, -1,  0).

%
% Create genetic program - Create a random genetic program
%
create_genetic_program(GP) :-
	maximum_initial_depth(MaxDepth),
	create_random_program(GP, MaxDepth, 0).
	
create_random_program(GP, MaxDepth, 0) :-
	% First one, choose a function
	select_random_function(Function),
	create_random_args(Args, MaxDepth, 0),
	concat([Function], Args, GP),!.

create_random_program(Terminal, Depth, Depth) :-
	select_random_terminal(Terminal).

create_random_program(GP, MaxDepth, CurrentDepth) :-
	% inner node, function or terminal
	select_random_construct(Construct),
	function_or_terminal(Construct, GP, MaxDepth, CurrentDepth).

function_or_terminal(Construct, Construct, MaxDepth, CurrentDepth) :-
	% The construct is a terminal
	terminals(Terminals),
	member(Construct, Terminals).

function_or_terminal(Construct, GP, MaxDepth, CurrentDepth) :-
	% Must be a function.
	create_random_args(Args, MaxDepth, CurrentDepth),
	concat([Construct], Args, GP).

create_random_args(Args, MaxDepth, CurrentDepth) :-
	% Two args cause all functions have 2 arguments.
	% Not very generic.
	NewDepth is CurrentDepth + 1,
	create_random_program(Arg1, MaxDepth, NewDepth),
	create_random_program(Arg2, MaxDepth, NewDepth),
	concat([Arg1], [Arg2], Args).
	
select_random_terminal(Terminal) :-
	terminals(Terminals),
	length(Terminals, Length),
	Rand is irand(Length),
	index(Terminals, Rand, Terminal).

select_random_function(Function) :-
	functions(Functions),
	length(Functions, Length),
	Rand is irand(Length),
	index(Functions, Rand, Function).

select_random_construct(Construct) :-
	terminals(Terminals),
	functions(Functions),
	concat(Terminals, Functions, Constructs),
	length(Constructs, Length),
	Rand is irand(Length),
	index(Constructs, Rand, Construct).

%
% Create Individual - create the data base elements for individuals
%
create_individual(Id, GP) :-
	% Assert the initial state
	asserta(x_pos(Id, 0)),
	asserta(y_pos(Id, 0)),
	asserta(fitness(Id, 0)),
	asserta(direction(Id, 0)),
	
	asserta(genetic_program(Id, GP)),
	
	% Make the environment.
	asserta(crumb(Id, 0, 1)),
	asserta(crumb(Id, 1, 1)),
	asserta(crumb(Id, 2, 1)),
	asserta(crumb(Id, 2, 2)),
	asserta(crumb(Id, 2, 3)),
	asserta(crumb(Id, 2, 5)),
	asserta(crumb(Id, 3, 6)),
	asserta(crumb(Id, 4, 5)),
	asserta(crumb(Id, 5, 4)),
	asserta(crumb(Id, 5, 2)),
	asserta(crumb(Id, 6, 2)),
	asserta(crumb(Id, 7, 2)),
	asserta(crumb(Id, 9, 3)),
	asserta(crumb(Id, 9, 4)),
	asserta(crumb(Id, 8, 5)),
	asserta(crumb(Id, 8, 7)),
	asserta(crumb(Id, 9, 9)).

%
% Create initial population
%
create_initial_population :-
	population_size(PopulationSize),
	add_individuals(PopulationSize).

add_individuals(0).
add_individuals(PopulationSize) :-
	Id is PopulationSize - 1,
	create_genetic_program(GP),
	create_individual(Id, GP),
	add_individuals(Id).

%
% Create new population - generate a new populartion of recombination.
%
create_new_population(0,[]).
create_new_population(PopulationSize, [Gene|Rest]) :-
	Id is PopulationSize - 1,
	create_individual(Id, Gene),
	create_new_population(Id, Rest).
	
%
% Crossover - perform crossover on two genetic programs
%
crossover(Parent1, Parent2, Offspring) :-
	% Select a random point in each parent
	number_of_nodes(Parent1, Node1),
	number_of_nodes(Parent2, Node2),
	
	% Select random nodes in each
	Rand1 is irand(Node1),
	Rand2 is irand(Node2),

	% Get the node of the second parent and sub it into the first
	get_expression(Parent2, Rand2, Expression),

	%pretty_print(Parent1),nl, 
	%write('Node Number: '), write(Rand1), nl,
	%write('Expression: '), write(Expression), nl,

	asserta(gp_nodes(0)),
	swap([Parent1], Rand1, Expression, [Offspring|_]),
	kill(gp_nodes),!.

swap([], _, _, []).
swap([H|T], Node, E, [E|O]) :-
	gp_nodes(Current),
	Node =:= Current,
	swap(T, 999, E, O).

swap([H|T], Node, E, [H|O]) :-
	atom(H),	
	inc_nodes,
	swap(T, Node, E, O).

swap([H|T], Node, E, [H2|T2]) :-
	swap(H, Node, E, H2),
	swap(T, Node, E, T2).
	
get_expression(GP, Node, E) :-
	asserta(gp_nodes(0)),
	ge([GP], Node, E),
	retract(gp_nodes(Node)).

ge([], _, _).

ge([H|T], Node, H) :-
	gp_nodes(Node).

ge([H|T], Node, E) :-
	atom(H),
	inc_nodes,
	ge(T, Node,E).
	
ge([H|T], Node, E) :-
	cdr(H, Cdr),
	inc_nodes,
	ge(Cdr, Node, E),
	cont(T, Node, E).
	
cont(_, _, E) :-
	nonvar(E).

cont(T,Node, E) :-
	ge(T, Node, E).


%
% Display stats - show some running statistics.
%
display_stats(Gen) :-
	write('----------------- Generation '),
	write(Gen),
	write(' ----------------------------'), nl,
	
	fitness_list(FitnessList),
	sort(FitnessList, SortedList),
	write(SortedList), nl.
	
%
% Evaluate - Evaluate a genetic program
%
evaluate(Who, GP) :-
	% test the actions limit. Keep executing as long as not yet reached.
	actions(Actions),
	maximum_actions(MaxActions),
	Actions &lt; MaxActions,
	
	debug_info('Actions:'), 
	debug_info(Actions),
	
	% Gather some stats
	x_pos(Who, Xpos),
	y_pos(Who, Ypos),
	fitness(Who, Fitness),
	debug_info(['      X: ', Xpos]),
	debug_info(['      Y: ', Ypos]),
	debug_info(['Fitness: ', Fitness]),
	
	
	% Run the genetic program
	eval(Who, GP),
	!,
	
	% Do it again...
	evaluate(Who, GP).
	
evaluate(Who, GP) :-
	debug_info('Evaluate Failed: '),
	debug_info(Who), debug_info(GP).

%
% Eval
%
eval(_, []).

eval(Who, [if_sensor, Arg1, Arg2]) :-
	if_sensor(Who),
	eval(Who, Arg1).
	
eval(Who, [if_sensor, Arg1, Arg2]) :-
	!,
	eval(Who, Arg2).
	
eval(Who, [begin, Arg1, Arg2]) :-
	eval(Who, Arg1),
	eval(Who, Arg2).
	
eval(Who, GP) :-
	atom(GP),
		
	% test the actions limit.
	actions(Actions),
	maximum_actions(MaxActions),
	Actions &lt; MaxActions,
	
	% make up the function call.
	functor(C, GP, 1),
	arg(1, C, Who),
	call(C).

eval(_,_).
% :-
%	debug_info('Eval Error').

% 
%
% Execute generations - run the simulation.
%
execute_generations(Generation) :-
	maximum_generations(MaxGens),
	MaxGens =:= Generation.

execute_generations(Generation) :-
	recombine(Generation),
	debug_info('...Before Fitness Test...'),
	
	fitness_test(0),
	display_stats(Generation),
	
	Next is Generation + 1,
	execute_generations(Next).
	

%
% Fitness test - execute individuals to obtain fitness.	
%
fitness_test(Who) :-
	% Exit condition
	population_size(Size),
	Who &lt; Size,
	
	debug_info('...Fitness Testing...'),
	
	% get the genetic program.
	genetic_program(Who, GP),
	
	% reset the actions counter
	kill(actions),
	assert(actions(0)),
	
	write('--------------------------------------------------------'),nl,
	write('Evaluate Individual No. '), write(Who), nl,
	pretty_print(GP), 
	
	evaluate(Who, GP),
	
	fitness(Who, Fitness),
	nl,
	write('Fitness:'), 
	write(Fitness),nl,
	write('--------------------------------------------------------'),nl,


	Next is Who + 1,
	!,
	fitness_test(Next).
	
fitness_test(_) :-
	debug_info('Fitness Test Failed').


%
% Number of Nodes - Number of possible swap nodes in a genetic program
%
number_of_nodes(GP, Nodes) :-
	asserta(gp_nodes(0)),
	nn([GP]),
	gp_nodes(Nodes),
	retract(gp_nodes(Nodes)), !.

inc_nodes :-
	gp_nodes(Nodes),
	retract(gp_nodes(Nodes)),
	NewNodes is Nodes + 1,
	asserta(gp_nodes(NewNodes)).
	

nn([]).

nn([H|T]) :-
	atom(H),
	inc_nodes,
	nn(T).
	
nn([H|T]) :-
	cdr(H, Cdr),
	inc_nodes,
	nn(Cdr),
	nn(T).
		
%
% Pretty Print - format genetic programs for debugging.
%
pretty_print(GP) :-
	pp([GP], 0), nl.
		
pp([], _) :-
	write(')').

pp([H|T], Tab) :-
	atom(H), nl,
	tab(Tab),
	write(H), 
	pp(T, Tab).
	
pp([H|T], Tab) :-
 	nl, 
	tab(Tab),
	car(H, Car),
	cdr(H, Cdr),
	write('('), write(Car), 
	NewTab is Tab + 4,
	pp(Cdr, NewTab),
	pp(T, Tab).

%
% Progam Depth - Measures the maximum depth of a genetic program.
%
program_depth(GP, Depth) :-
	asserta(gp_depth(0)),
	traverse([GP], 0),
	gp_depth(Depth),
	retract(gp_depth(Depth)).
	
new_depth(Depth) :-
	gp_depth(Current),
	Depth &gt; Current,
	kill(gp_depth),
	asserta(gp_depth(Depth)).
new_depth(_).

traverse([], D).
traverse([H|T], Depth) :- 
	atom(H),
	traverse(T, Depth).	
traverse([H|T], Depth) :- 
	New is Depth + 1,
	new_depth(New),
	traverse(H, New),
	traverse(T, Depth).

%
% Recombine - Select individuals proportionate to fitness and 
%             make a new population.
%
recombine(0).
	% don't recombine first generation. No point.
	% bagof(GeneticProgram, Id^(genetic_program(Id, GeneticProgram)), GP).
	
recombine(_) :-
	%debug_info('...Recombination...'),
	
	% Make a list of gp's, sorted by fitness.
	fitness_list(FitnessList),
	%debug_info('Fitness list obtained'),
	%debug_info(FitnessList),
	
	sort(FitnessList, SortedList),
	%debug_info('Fitness list sorted:'),
	%debug_info(SortedList),
	
	total_fitness(SortedList, TotalFitness),
	%debug_info('Total fitness caculated:'),
	%debug_info(TotalFitness),
	
	% Mate them.
	population_size(Size),
	make_new_genes(Size, SortedList, TotalFitness, NewPop),
	
	%debug_info('The new population:'),
	%debug_info(NewPop),	
	
	% kill the old and make a new.
	kill_old_population,
	create_new_population(Size, NewPop).

total_fitness([], 0).
total_fitness([H|Rest], Total) :-
	total_fitness(Rest, SoFar),
	car(H, Fitness),
	Total is Fitness + SoFar.
	
kill_old_population :-	
	kill(fitness),
	kill(crumb),
	kill(x_pos),
	kill(y_pos),
	kill(direction),
	kill(actions),
	kill(genetic_program).

make_new_genes(0, SortedList, TotalFitness, []).
make_new_genes(Id, SortedList, TotalFitness,  [Baby|T]) :-
	% select two gp's proportionate to fitness
	select_random_individual(Person1, SortedList, TotalFitness),
	select_random_individual(Person2, SortedList, TotalFitness),
	
	%debug_info('Selected Person 1:'),
	%debug_info(Person1),
	%debug_info('Selected Person 2:'),
	%debug_info(Person2),
		
	% perform crossover and keep the offspring.
	genetic_program(Person1, Gene1),
	genetic_program(Person2, Gene2),
	crossover(Gene1, Gene2, Baby),

	Next is Id - 1,
	make_new_genes(Next, SortedList, TotalFitness, T).
					   
% Each element is the pair [Id, Fitness].
fitness_list(L) :-
	population_size(PopSize),
	First is PopSize -1,
	make_fitness_list(First, L),!.
	
make_fitness_list(0, [H|[]]) :-
	fitness(0, Fitness),
	concat([Fitness], [0], H).
	
make_fitness_list(Id, [H|T]) :-
	fitness(Id, Fitness),
	concat([Fitness], [Id], H),
	New is Id - 1,
	make_fitness_list(New, T).

%
% Select random indivdual - Fitness proportionate selection.
%
select_random_individual(Individual, SortedList, TotalFitness) :-
	% Select an individual (first element) from the list proportionate 
	% to their fitness(second element).
	Random is irand(TotalFitness),
	debug_info('Random Fitness selected:'),
	debug_info(Random),
	s_r_i(Individual, SortedList, 0, Random).

s_r_i(_,[],_,_) :-
	write('Individual Selection Error').

s_r_i(Id, [H|T], FitnessSoFar, Rnd) :-
	car(H, Fitness),
	NewFitness is FitnessSoFar + Fitness,
	Rnd =&lt; NewFitness,
	cdr(H, IdList),
	car(IdList, Id).

s_r_i(Id, [H|T], FitnessSoFar, Rnd) :-
	car(H, Fitness),
	NewFitness is FitnessSoFar + Fitness,
	s_r_i(Id, T, NewFitness, Rnd).
	
	
%
% Test Harness
%	
gp :-
	kill_old_population,
	create_initial_population,
	execute_generations(0).


k :-
	kill(fitness),
	kill(crumb),
	kill(x_pos),
	kill(y_pos),
	kill(direction),
	kill(genetic_program).
%
% Auxilliary Procedures
%
car([H|_], H).
cdr([_|T], T).

index([Element|List], Index, Element) :-
	Index =:= 0.
index([Element|List], Index, E) :-
	NewIndex is Index - 1,
	index(List, NewIndex, E).

member(E, [E|_]).
member(E, [_|T]) :- member(E, T).
	
</pre></body></html>