:- use_module(library(dcgs)). :- use_module(library(random)). :- use_module(library(lists)). :- use_module(library(pairs)). :- use_module(library(format)). :- use_module(library(ordsets)). % precondition: indices is sorted. (w/none out of range) indices_cindex_list_selected_rest([], _I, Ls, [], Ls). indices_cindex_list_selected_rest([I0|Is], I0, [L|Ls], Ss0, Rs0) :- !, Ss0 = [L|Ss], I1 is I0 + 1, indices_cindex_list_selected_rest(Is, I1, Ls, Ss, Rs0). indices_cindex_list_selected_rest(Xs, I0, [L|Ls], Ss0, [L|Rs]) :- I1 is I0 + 1, indices_cindex_list_selected_rest(Xs, I1, Ls, Ss0, Rs). rand_set(K, N, Set) :- % bug in SICStus 3#7 ( randset(K, N, Set) -> true ). % randset does NOT terminate if(Cond, Then, _) :- Cond, !, Then. if(_, _, Else) :- Else. randseq(0, _, []) :- !. randseq(K, N, [R|Rs]) :- random_integer(0, N, R0), R is R0 + 1, K1 is K - 1, randseq(K1, N, Rs). same_length(As, Bs, L) :- length(As, L), length(Bs, L). randset(K, N, S) :- randseq(K, N, S0), sort(S0, S). numberofmutations(2). % pretty low populationsize(50). % also (seems to work) startga(MaxIter) :- % INIT AND START MAIN LOOP initialpopulation(P0), % random valid sols ga(P0, 0, MaxIter). % start w/iteration #0 initialpopulation(P) :- % GEN INITIAL POPULATION allboxes(Boxes), numberofboxes(NumberOfBoxes), populationsize(PSize), length(P, PSize), initialpopulation_boxes_numberofboxes(P, Boxes, NumberOfBoxes). initialpopulation_boxes_numberofboxes([], _Boxes, _NumberOfBoxes). initialpopulation_boxes_numberofboxes([Xs|Xss], Boxes, NumberOfBoxes) :- randseq(NumberOfBoxes, NumberOfBoxes, Rs), phrase(newsolutionrnd_boxes_cclique_ccosts(Rs, Boxes, [], 0), Xs), initialpopulation_boxes_numberofboxes(Xss, Boxes, NumberOfBoxes). %newsolutionrnd_boxes_cclique_ccosts([], _Bs, Cs0, _Costs) --> % { if(Cs0=[], [], (sort(Cs0,Cs),[Cs])) }. newsolutionrnd_boxes_cclique_ccosts([], _Bs, Cs0, _Costs, Rest0, Rest) :- ( Cs0 = [] -> Rest0 = Rest ; sort(Cs0, Cs), Rest0 = [Cs|Rest] ). newsolutionrnd_boxes_cclique_ccosts([X|Xs], Boxes, Cs0, Costs0) --> { nth1(X, Boxes, ChosenBox), box_weight(ChosenBox, Weight) }, ( { Costs is Costs0 + Weight, validcontainerweight(Costs) } -> { Cs = [ChosenBox|Cs0] } % put item into container ; [Cs1], { sort(Cs0, Cs1) }, % --> std. order { Cs = [ChosenBox], Costs = Weight } % start new clique ), newsolutionrnd_boxes_cclique_ccosts(Xs, Boxes, Cs, Costs). ga(_P, Iter, Iter). ga(P0, Iter0, Iter) :- % MAIN LOOP Iter0 @< Iter, displaystatistics_(P0, Iter0), oldpopulation_newpopulation(P0, P), Iter1 is Iter0 + 1, ga(P, Iter1, Iter). displaystatistics_(P, I) :- % DISPLAY STATISTICS population_bestfitness_meanfitness(P, BestF, MeanF), length(Bst, BestF), memberchk(Bst, P), % get 1st with best fitness format("#~d: mean: ~f, best: ~d (~w).~n", [I, MeanF, BestF, Bst]). population_bestfitness_meanfitness(P,BF,MF) :- % GET STATISTICS population_best0_best_sum0_sum(P, max, BF, 0, Sum), length(P, LenP), MF is Sum/LenP. population_best0_best_sum0_sum([], B, B, S, S). population_best0_best_sum0_sum([Xs|Xss], B0, B, S0, S) :- individuum_fitness(Xs, Fitness), if(Fitness @< B0, Fitness=B1, B0=B1), S1 is S0 + Fitness, population_best0_best_sum0_sum(Xss, B1, B, S1, S). mutate_all0_all([], As, As). % MUTATION LOOP mutate_all0_all([X|Xs], As0, As) :- individuum_mutated(X, Z), mutate_all0_all(Xs, [Z|As0], As). fathers_mothers_children([], [], []). % RECOMBINATION LOOP fathers_mothers_children([F|Fs], [M|Ms], [C|Cs]) :- father_mother_child(F, M, C), fathers_mothers_children(Fs, Ms, Cs). individuum_fitness(I, F) :- % FITNESS = # OF CONTAINERS length(I, F). individuum_fitterthan([], [_|_]). individuum_fitterthan([_|Xs], [_|Zs]) :- individuum_fitterthan(Xs, Zs). oldpopulation_newpopulation(P0, P) :- % MAKE NEW POPULATION populationsize(PSize), same_length(Fs, Ms, PSize), % selection length(P0, P0Size), selectedparents_oldpopulation_size(Fs, P0, P0Size), selectedparents_oldpopulation_size(Ms, P0, P0Size), fathers_mothers_children(Fs, Ms, Cs), % recombination ( numberofmutations(NrOfMutations), NrOfMutations > 0 -> rand_set(NrOfMutations, PSize, Rs), % mutation indices_cindex_list_selected_rest(Rs, 1, Cs, SelM, SelR), mutate_all0_all(SelM, SelR, P) ; Cs = P ). selectedparents_oldpopulation_size([], _P, _S). % 2-TOURNAMENT SELECTION selectedparents_oldpopulation_size([X|Xs], P0, PSize) :- rand_set(2, PSize, Tournament), indices_cindex_list_selected_rest(Tournament, 1, P0, [S0,S1], _Rs), if(individuum_fitterthan(S0, S1), X=S0, X=S1), selectedparents_oldpopulation_size(Xs, P0, PSize). father_mother_child(F0, M0, C) :- % RECOMBINATION l_augmented(F0, F1), keysort(F1, F2), pairs_values(F2, F), l_augmented(M0, M1), keysort(M1, M2), pairs_values(M2, M), father_mother_child2(F, M, C0), % clique-join phrase(seqq(C0), Es0), ( length(Es0, Es0Len), numberofboxes(Es0Len) % complete? -> C0 = C ; allboxes(AllBoxes), sort(Es0, Es), ord_subtract(AllBoxes, Es, Diff), % add boxes that have been lost length(Diff, NumberOfBoxes), randseq(NumberOfBoxes, NumberOfBoxes, Rs), phrase(newsolutionrnd_boxes_cclique_ccosts(Rs, Diff, [], 0), C, C0) ). l_augmented([], []). l_augmented([Xs|Xss], [FN-Xs|Zss]) :- boxes_weight0_weight(Xs, 0, L), FN is -L, l_augmented(Xss, Zss). father_mother_child2([], Ms, Ms) :- !. % join list of cliques ($$$) father_mother_child2(Fs, [], Fs) :- !. father_mother_child2([J|Fs], Ms0, [J|Js]) :- cliques_clique_disjoint(Ms0, J, Ms), father_mother_child2(Ms, Fs, Js). cliques_clique_disjoint([], _C, []). % del non-disj. cliques ($$$) cliques_clique_disjoint([Xs|Xss], Cs, Dss0) :- if(ord_disjoint(Xs, Cs), Dss0=[Xs|Dss], Dss0=Dss), cliques_clique_disjoint(Xss, Cs, Dss). individuum_mutated(I0, I) :- % MUTATION length(I0, I0Len), rand_set(2, I0Len, Pos), % select 2 arbitrarily indices_cindex_list_selected_rest(Pos, 1, I0, [A,B], Rs), append(A, B, AB), % try to join them ( boxes_weight0_weight(AB, 0, W_AB), validcontainerweight(W_AB) -> I = [AB|Rs] ; length(AB, LenAB), % repair is necessary randseq(LenAB, LenAB, Rnd), % split up into random parts phrase(newsolutionrnd_boxes_cclique_ccosts(Rnd, AB, [], 0), I, Rs) ).