Marco Zimmerling wrote: > Hi Philipp, > > I'm not aware of any ECLiPSe framework for Pareto front > generation/approximation. Dear all, I replied as a private mail to Philipp, that kindly asked me to provide him the implementation I described in Marco Gavanelli. An algorithm for multi-criteria optimization in CSPs. In Frank van Harmelen, editor, ECAI 2002. Proceedings of the 15th European Conference on Artificial Intelligence, pages 136-140, Lyon, France, July 21-26 2002. IOS Press. I post it on the mailing list, as it may be useful to other people as well. The problem is that it works with the FD library, and not with the new IC library. Cheers, Marco > Dear Philipp, > > I am sending you the module I used. > Unluckily, it is tailored for the old fd library of ECLiPSe, I believe it will not work with the new ic library for constraint solving. > > Anyway, fd is still present in the ECLiPSe package, and it is fully functional. > > Basically, I tried to re-implement the same interface as the minimize predicate, but with two objectives. So, you have the predicates: > > multi_minimize(Goal, Cost, Solution) > > that, given a Goal and a list of two cost variables [C1,C2], returns a list of lists which represents the Pareto front. > So, it extends the minimize/2 predicate: > > http://eclipse-clp.org/doc/bips/lib/fd/minimize-2.html > > In the same way, the following predicates: > > multi_minimize(Goal, Template, Solution, Cost) > multi_minimize(Goal, Cost, Lower, Upper, Percent) > multi_minimize(Goal, Cost, Lower, Upper, Percent, Timeout) > multi_minimize(Goal, Template, Solution, Value, Lower, Upper, Percent, Timeout) > > extend the variants of minimize with more parameters > > http://eclipse-clp.org/doc/bips/lib/fd/minimize-2.html > http://eclipse-clp.org/doc/bips/lib/fd/minimize-4.html > http://eclipse-clp.org/doc/bips/lib/fd/minimize-6.html > http://eclipse-clp.org/doc/bips/lib/fd/minimize-8.html > > If you have more questions, or find some bug, please let me know. > > Best, > Marco -- Marco Gavanelli, Ph.D. in Computer Science Dept of Engineering University of Ferrara Tel/Fax +39-0532-97-4833 http://www.ing.unife.it/docenti/MarcoGavanelli/ % Version with Quad-Trees only in 2D % ---------------------------------------------------------------------- % System: ECLiPSe Constraint Logic Programming System % Copyright (C) Imperial College London and ICL 1995-1999 % Version: $Id: fd.pl,v 1.25 2000/05/19 08:59:44 js10 Exp $ % ---------------------------------------------------------------------- /* /* * SEPIA PROLOG SOURCE MODULE */ /* * sccsid("%W% %E%"). * sccscr("%Z% Copyright 1989, 1993 ECRC GmbH "). */ /* * FINITE DOMAINS * * IDENTIFICATION: pcop.ecl * * AUTHOR: Marco Gavanelli * * DESCRIPTION: Multiobjective Optimization */ :- module(pcop). %:- comment(summary, "Finite domain library"). %:- comment(author, "Micha Meier, ECRC Munich"). %:- comment(copyright, "Imperial College London and ICL"). %:- comment(date, "$Date"). %:- comment(include, "fd_doc.ecl"). :- lib(fd). :- lib(fd_global). :- TopPreds = ( multi_minimize/3, multi_minimize/4, multi_minimize/5, multi_minimize/6, multi_minimize/8, multi_minimize_bound_check/0, multi_min_max/3, multi_min_max/4, multi_min_max/5, multi_min_max/6, multi_min_max/8), export(TopPreds). :- tool(multi_minimize/3, multi_minimize_body/4), tool(multi_minimize/4, multi_minimize_body/5), tool(multi_minimize/5, multi_minimize_body/6), tool(multi_minimize/6, multi_minimize_body/7), tool(multi_minimize/8, multi_minimize_body/9), tool(multi_min_max/3, multi_min_max_body/4), tool(multi_min_max/4, multi_min_max_body/5), tool(multi_min_max/5, multi_min_max_body/6), tool(multi_min_max/6, multi_min_max_body/7), tool(multi_min_max/8, multi_min_max_body/9). :- export multi_minimize_body/4, multi_minimize_body/5, multi_minimize_body/6, multi_minimize_body/7, multi_minimize_body/9, multi_min_max_body/4, multi_min_max_body/5, multi_min_max_body/6, multi_min_max_body/7, multi_min_max_body/9. :- import % general-purpose predicates call_local/1, maxint/1, minint/1, par_true/0, prune_woken_goals/1, worker_boundary/0 from sepia_kernel. %:- pragma(nodebug). %:- pragma(system). :- local struct(quad(solution,cost,nw,se)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Event Handling %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- set_event_handler(multi_bb, multi_bb_handler/1). :- local variable(last_cost). multi_bb_handler(_) :- write("Found a solution with cost "), getval(last_cost,Cost), writeln(Cost). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Higher-order predicates % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This lock is needed for atomic update of the cost bound in minimize :- make_local_array(minimize_lock), mutex_init(minimize_lock). :- make_local_array(minimize_stack, global_reference). %Ma da questo stack non viene mai eliminato nulla? Come fa a %funzionare? push(StackName, Item) :- getval(StackName, Stack), setval(StackName, [Item|Stack]). top(StackName, Top) :- getval(StackName, Stack), nonvar(Stack), Stack = [Top|_]. % % Min-Max: Branch & Bound by restarting each time a new solution is found. % % Simplified versions with less arguments multi_min_max_body(Goal, Cost, Solution, Module) :- gen_min_max_lists(Cost,MinList,MaxList), term_variables(Goal, SolTemplate), multi_min_max_body(Goal, SolTemplate, Solution, Cost, MinList, MaxList, 0, 0, Module). multi_min_max_body(Goal, Template, Solution, Cost, Module) :- gen_min_max_lists(Cost,MinList,MaxList), multi_min_max_body(Goal, Template, Solution, Cost, MinList, MaxList, 0, 0, Module). multi_min_max_body(Goal, Cost, Lower, Upper, Percent, Module) :- multi_min_max_body(Goal, Goal, Goal, Cost, Lower, Upper, Percent, 0, Module). multi_min_max_body(Goal, Cost, Lower, Upper, Percent, Timeout, Module) :- multi_min_max_body(Goal, Goal, Goal, Cost, Lower, Upper, Percent, Timeout, Module). % The general min_max with all options multi_min_max_body(Goal, Template, Solution, Value, Lower, Upper, Percent, Timeout, Module) :- prune_woken_goals(Goal), % Parte in cui si gestiva la minimizzazione del massimo % ( var(Value) -> List = [Value] % ; Value = [_|_] -> List = Value % ; List = [Value] % ), Value = List, % Find the list of the worst possible values: Max % And the one of best possible values: Low (foreach(X,Value), foreach(Y,Max), foreach(M,Upper) do dvar_domain(X,Dom), dom_range(Dom,_MinDom,MaxDom), Y is min(MaxDom,M)), % Semplifichiamo, mi fa dei casini Lower = Low, create_unback_store(Index), add_unback_constraint(Index,sol(no_solution,Max)), % term_arr(sol(no_solution,Max), Index), % the s/1 wrapper makes it fail safely if no solution bbr2(Goal, s(Template), s(Solution), List, Low, Max, Percent, Timeout, Index, Module) % ; % error(5, multi_min_max(Goal, Value, Lower, Upper, Percent, Timeout), Module) % ). . bbr2(Goal, Template, _Solution, List, Low, Max, Percent, Timeout, Index, Module) :- block(call_local(branch_and_bound_restart(Goal, Template, List, Low, Max, Percent, Timeout, Index, Module)), Tag, handle_exit(Tag)). bbr2(_Goal, _Template, Solution, _, _, _, _, _, Index, _) :- get_solutions(Index,Solution), % xget(Index, 1, Solution), % fail here if no solution destroy_unback_store(Index), % arr_abolish(Index), fd_true. branch_and_bound_restart(Goal, Solution, List, Low, Max, Percent, Timeout, Index, Module) :- worker_boundary, push(minimize_stack, multi_min_max), par_true, % for better incremental stack copying ( Timeout>0 -> event_after(fd_timeout, Timeout) ; true), repeat, % xget(Index, 2, M), ( % We suppose that only constraints on costs are % unbacktrackable post_unback_constraints(Index,List), % constrain_max_list(List, M), % post new cost constraints call(Goal, Module), schedule_suspensions(postponed), wake -> %max_of_min_list_domains(List, Cost), % Cost e` unbound se c'e` stato un errore (piu` di una var % unbound) % altrimenti unifica Cost con % il massimo dei minimi. Se c'e` solo una var, la unifica % Soluzione semplice: rende ground le variabili istanziandole % al loro minimo. Se ce la fa (senza fallire), ok, altrimenti % da` errore (non facciamo backtracking sul Goal) (make_ground(List) -> setval(last_cost,List), event(multi_bb), % error(280, (List, Goal)), % In case the solution still contains variables, % we want to strip most of their attributes. % Otherwise we might copy the whole constraint store! copy_term(Solution, StrippedSolution), % xset(Index, 1, StrippedSolution), % NewUp is min(Cost - fix(Cost * Percent)//100, Cost - 1), % xset(Index, 2, NewUp), calc_new_up(NewUp,List,Percent,Low), add_unback_constraint(Index,sol(StrippedSolution,NewUp)), % According to the chipc manual this should be NewUp < Low ! %Cost < Low % restart from repeat fail % Spero che non venga ottimizzato ; error(4, multi_min_max(Goal, List, Low, Max, Percent), Module) ) ; true ), !, cancel_after_event(fd_timeout), % may fail fail. % % Minimize: Branch & Bound by backtracking, the cost limit is represented % by a global variable. This version might not be as efficient % as when a new (non-backtrackable) constraint is actually added % to the store. It can be improved by an explicit check % on every labeling step: multi_minimize_bound_check/0 % % Simplified versions with less arguments multi_minimize_body(Goal, Cost, Solution, Module) :- gen_min_max_lists(Cost,MinList,MaxList), term_variables(Goal, SolTemplate), multi_minimize_body(Goal, SolTemplate, Solution, Cost, MinList, MaxList, 0, 0, Module). multi_minimize_body(Goal, Template, Solution, Cost, Module) :- gen_min_max_lists(Cost,MinList,MaxList), multi_minimize_body(Goal, Template, Solution, Cost, MinList, MaxList, 0, 0, Module). multi_minimize_body(Goal, Cost, Lower, Upper, Percent, Module) :- multi_minimize_body(Goal, Goal, Goal, Cost, Lower, Upper, Percent, 0, Module). multi_minimize_body(Goal, Cost, Lower, Upper, Percent, Timeout, Module) :- multi_minimize_body(Goal, Goal, Goal, Cost, Lower, Upper, Percent, Timeout, Module). % The general minimize with all options multi_minimize_body(Goal, Template, Solution, Value, Lower, Upper, Percent, Timeout, Module) :- % prune_woken_goals(Goal), % ( var(Value) -> List = [Value] % ; Value = [_|_] -> List = Value % ; List = [Value] % ), Value = List, % Find the list of the worst possible values: Max % And the one of best possible values: Low (foreach(X,Value), foreach(Y,Max), foreach(M,Upper) do dvar_domain(X,Dom), dom_range(Dom,_MinDom,MaxDom), Y is min(MaxDom,M)), % ( max_list_range(List, var, MinList, MaxList) -> % Low is max(MinList, Lower), % Max is min(MaxList, Upper), Lower = Low, create_unback_store(Index), % add_unback_constraint(Index,sol(deleted,[0,0])), dummyconstraint add_unback_constraint(Index,sol(no_solution,Max)), bb2(Goal, s(Template), s(Solution), List, Low, Max, Percent, Timeout, Index, Module) % ; % ( Goal == Template -> % error(5, minimize(Goal, Value, Lower, Upper, Percent, Timeout), Module) % ; % error(5, minimize(Goal, Template, Solution, Value, Lower, Upper, Percent, Timeout), Module) % ) % ). . :- mode gen_min_max_lists(?,-,-). gen_min_max_lists(Cost,MinList,MaxList) :- length(Cost,N), length(MinList,N), checklist(minint,MinList), length(MaxList,N), checklist(maxint,MaxList). bb2(Goal, Template, _Solution, List, Low, Max, Percent, Timeout, Index, Module) :- block(call_local(branch_and_bound(Goal, Template, List, Low, Max, Percent, Timeout, Index, Module)), Tag, handle_exit(Tag)). bb2(_Goal, _Template, Solution, _, _, _, _, _, Index, _) :- get_solutions(Index,Solution), % xget(Index, 1, Solution), % fail here if no solution destroy_unback_store(Index), % arr_abolish(Index), fd_true. branch_and_bound(Goal, Solution, List, Low, Max, Percent, Timeout, Index, Module) :- worker_boundary, % constrain_max_list_index(List, Index), post_minimize_unback_constraints(Index,List), push(minimize_stack, List/Index), ( Timeout>0 -> event_after(fd_timeout, Timeout) ; true), call(Goal, Module), % max_of_min_list_domains(List, Cost), % make_ground(List), schedule_suspensions(postponed), wake, (make_ground(List) -> mutex(minimize_lock, ( setval(last_cost,List), event(multi_bb), % error(280, (List, Goal)), % In case the solution still contains variables, % we want to strip most of their attributes. % Otherwise we might copy the whole constraint store! copy_term(Solution, StrippedSolution), calc_new_up(NewUp,List,Percent,Low), add_unback_constraint(Index,sol(StrippedSolution,NewUp)), fail % Spero che non venga ottimizzato )) % (nonvar(Cost) -> % % Update cost if better. This must be atomic. % mutex(minimize_lock, ( % Cost =< xget(Index, 2), % error(280, (Cost, Goal)), % copy_term(Solution, StrippedSolution), % xset(Index, 1, StrippedSolution), % NewUp is min(Cost - fix(Cost * Percent)//100, Cost - 1), % xset(Index, 2, NewUp), % Cost < Low % backtrack into Goal % )) ; error(4, minimize(Goal, List, Low, Max, Percent), Module) ), !, cancel_after_event(fd_timeout), % may fail fail. branch_and_bound(_, _, _, _, _, _, _, _, _) :- cancel_after_event(fd_timeout), % may fail fail. % Get the minimum and maximum value of a list of domain vars % Where gets unified with 'expr' when the list contains expressions max_list_range(List, Where, Min, Max) :- maxint(Maxint), minint(Minint), max_list_range(List, Where, Minint, Max, Maxint, Min). max_list_range([], _, Max, Max, Min, Min). max_list_range([Var|Rest], Where, SoFar, Max, MinSoFar, Min) :- ( dvar_domain(Var, Domain) -> true ; default_domain(Var), dvar_domain(Var, Domain) ), dom_range(Domain, DMin, DMax), !, NewMin is min(MinSoFar, DMin), NewMax is max(SoFar, DMax), max_list_range(Rest, Where, NewMax, Max, NewMin, Min). max_list_range([Term|Rest], expr, SoFar, Max, MinSoFar, Min) :- term_to_linear(Term, LTerm), linear_term_range(LTerm, DMin, DMax), NewMin is min(MinSoFar, DMin), NewMax is max(SoFar, DMax), max_list_range(Rest, _Where, NewMax, Max, NewMin, Min). % Constrain all variables in the list to be smaller than Max constrain_max_list([], _). constrain_max_list([Term|Rest], Max) :- Term #<= Max, constrain_max_list(Rest, Max). % Constrain all variables in the list to be smaller than the cost bound constrain_max_list_index([], _). constrain_max_list_index([Term|Rest], Index) :- constrain_max_index(Term, Index), constrain_max_list_index(Rest, Index). constrain_max_index(Term, Index) :- var(Term), xget(Index, 2, Max), Term #<= Max, make_suspension(constrain_max_index(Term, Index), 2, Susp), insert_suspension(Term, Susp, min of fd). constrain_max_index(Term, Index) :- nonvar(Term), xget(Index, 2, Max), Term =< Max. % % Explicit check that can be used with minimize in additional choice points % multi_minimize_bound_check :- ( top(minimize_stack, List/Index) -> check_max_list_index(List, Index) ; true % stack empty or we are in a multi_min_max (no check needed) ). check_max_list_index([], _). check_max_list_index([Term|Rest], Index) :- check_max_index(Term, Index), check_max_list_index(Rest, Index). check_max_index(Term, Index) :- var(Term), xget(Index, 2, Max), Term #<= Max. check_max_index(Term, Index) :- nonvar(Term), xget(Index, 2, Max), Term =< Max. max_of_min_list_domains([], Cost, Cost, _, _). max_of_min_list_domains([Term|Rest], SoFar, Max, Var, Val) :- nonvar(Term), !, min_domain(Term, DMin), (DMin > SoFar -> max_of_min_list_domains(Rest, DMin, Max, Var, Val) ; max_of_min_list_domains(Rest, SoFar, Max, Var, Val) ). max_of_min_list_domains([Var|Rest], SoFar, Max, Var, DMin) :- var(DMin), % fail if not the first variable min_domain(Var, DMin), (DMin > SoFar -> max_of_min_list_domains(Rest, DMin, Max, _, DMin) ; max_of_min_list_domains(Rest, SoFar, Max, _, DMin) ). min_domain(Term, Min) :- nonvar(Term), !, (nonground(Term) -> term_to_linear(Term, LTerm), linear_term_range(LTerm, Min, Min) ; Min is Term ). min_domain(Var, Min) :- dvar_domain(Var, Domain), dom_range(Domain, Min, _). max_of_min_list_domains([Term|List], Cost) :- min_domain(Term, Min), (max_of_min_list_domains(List, Min, Cost, Var, Val) -> Var = Val ; true % unbound if an error ). % A true which is not optimized away so that we have a call instruction which % forces a debugger event which traces the woken goals before the exit... fd_true. % % Event handling % handle_exit(fd_timeout) :- !, fail. handle_exit(Tag) :- ( cancel_after_event(fd_timeout) -> true ; true ), exit_block(Tag). :- set_event_handler(fd_timeout, exit_block/1). :- untraceable branch_and_bound/9, % called from block branch_and_bound_restart/9. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% make_ground(L) :- labeling(L). get_solutions(Index,s(Solutions)) :- get_unback_store(Index,Store), provide_solutions(Store,Solutions), Store \= []. % The empty list means there are no solutions provide_solutions([],[]). provide_solutions(quad with [nw:NW,se:SE,solution:S],List):- (S=no_solution ; S=deleted, writeln("DELETED")), !, provide_solutions(NW,L1), provide_solutions(SE,L2), append(L1,L2,List). provide_solutions(quad with [nw:NW,se:SE,solution:S],[S|List]):- provide_solutions(NW,L1), provide_solutions(SE,L2), append(L1,L2,List). %provide_solutions([],[]). %provide_solutions([sol(no_solution,_)|T],S) :- !, % provide_solutions(T,S). %provide_solutions([sol(S,_)|T],[S|Ts]) :- % provide_solutions(T,Ts). % Per ora il campo Percent non e` considerato!!! calc_new_up(NewUp,List,_Percent,Low) :- (foreach(Cost,List), foreach(Y,NewUp), foreach(LL,Low) do (Cost =< LL -> minint(Y) ; Y = Cost)). % NewUp is min(Cost - fix(Cost * Percent)//100, Cost - 1), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Unbacktrackable Constraint Store %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- mode create_unback_store(-). create_unback_store(Index) :- shelf_create(store/2,[],Index), shelf_set(Index,2,0). destroy_unback_store(Index) :- shelf_abolish(Index). get_unback_store(Index,Store,Flag) :- shelf_get(Index,1,Store), shelf_get(Index,2,Flag). get_unback_store(Index,Store) :- shelf_get(Index,1,Store). %In this case we have to impose a constraint for each optimization %funtion add_unback_constraint(Index,sol(no_solution,MaxCost)) :- !, shelf_get(Index,1,Store), findall(Plane,gen_top_planes(MaxCost,Plane),LPlane), insert_no_solution_in_store(Store,LPlane,NewStore), shelf_set(Index,1,NewStore), shelf_get(Index,2,Flag), Flag1 is Flag+1, shelf_set(Index,2,Flag1). %Note: Cost is not the cost list associated to Solution %it represents the constraint we have to impose (thus, it is %influenced by Percent, Low, ... add_unback_constraint(Index,sol(Solution,Cost)):- shelf_get(Index,1,Store), % If the root is a no_solution, re-arrange the tree (Store=quad with solution:no_solution -> insert_in_store([],sol(Solution,Cost),TempStore), reinsert(TempStore,Store,NewStore) ; insert_in_store(Store,sol(Solution,Cost),NewStore)), shelf_set(Index,1,NewStore), shelf_get(Index,2,Flag), Flag1 is Flag+1, shelf_set(Index,2,Flag1). insert_no_solution_in_store(Store,[],Store). insert_no_solution_in_store(Store,[H|T],NewStore):- insert_in_store(Store,sol(no_solution,H),TempStore), insert_no_solution_in_store(TempStore,T,NewStore). %gen_top_planes([],[]). gen_top_planes([X|T],[X1|MinIntList]) :- X1 is X+1, % perche' i vincoli sono con il < e l'interfaccia % col =< length(T,N), length(MinIntList,N), checklist(minint,MinIntList). gen_top_planes([_|T],[MinInt|Tm]) :- minint(MinInt), gen_top_planes(T,Tm). %With this idea, constraints are posted to the constraint store from %the unbacktrackable store. Each constraint is copied once. post_unback_constraints(Index,List) :- get_unback_store(Index,Store), post_unback_list(Store,List). post_unback_list([],_). post_unback_list([sol(_,Costs)|T],List) :- nondominated(List,Costs), post_unback_list(T,List). %Version 2: since the unbacktrackable store is sorted %antilexicographically, when I find a point with F1<Min(CurrentF1) %I can stop % Good idea, but it does not improve anything % %post_unback_list(L,[F1|Cost]) :- % dvar_domain(F1,Dom), dom_range(Dom,Min,_), % post_unback_list(L,[F1|Cost],Min). % %post_unback_list([],_,_). %post_unback_list([sol(_,[C1|_])|_],_,Min) :- C1<Min,!. %post_unback_list([sol(_,Costs)|T],List,Min) :- % nondominated(List,Costs), % post_unback_list(T,List,Min). %In this idea, there is only one unbacktrackable constraint that %propagates all the constraints in the unbacktrackable store. %Flag is a value; if it is equal to the one recorded in the store, %then nothing to do: all the constraints were already posted. If %Flag is different, then some constraint has been added since they %were posted the last time %:- mode post_minimize_unback_constraints(++,?,+,-). post_minimize_unback_constraints(Index,List) :- get_unback_store(Index,Store), % call_priority( (propagate_unback(Store,List), make_suspension(post_minimize_unback_constraints(Index,List),10,Susp), insert_suspension(List,Susp,min of fd, fd) ). % ,2). %Without call_priority the constraint is interrupted by other %constraints, thus in some cases (if the variables become ground) %it will not be reexecuted anymore. In this case we will get seom %nondominated solutions (that are not inserted in the store). It %seems more efficient without call_priority %The store is sorted in anti-lexicographic order. %In next implementations it can be unsorted %or with a Quad-Tree. Or there could be only one constraint that %reads the Quad-Tree %insert_in_store([],X,[X]). %insert_in_store([sol(Sol1,Cost1)|T],sol(Sol2,Cost2),[sol(Sol2,Cost2),sol(Sol1,Cost1)|T]) :- % antilexico(Cost2,Cost1), !. %%The current solution cannot be dominated (because of the %%constraints). If it dominates a solution, the dominated is deleted %%from the store. %insert_in_store([sol(_Sol1,Cost1)|T],sol(Sol2,Cost2),L):- % dominates(Cost2,Cost1),!, % insert_in_store(T,sol(Sol2,Cost2),L). %insert_in_store([sol(Sol1,Cost1)|T],sol(Sol2,Cost2),[sol(Sol1,Cost1)|L]):- % insert_in_store(T,sol(Sol2,Cost2),L). %:- mode dominates(++,++). dominates([],[]). dominates([A|La],[B|Lb]) :- A =< B, dominates(La,Lb). antilexico([],[]). antilexico([A|_TA],[B|_TB]) :- A>B. antilexico([A|TA],[A|TB]) :- antilexico(TA,TB). % % nondominated constraint % % Note: in this implementation it is satisfied if the solution is % not dominated. Future work: the solution should be strictly non % dominated. nondominated(Lx,Vx) :- (strip_dominated_coords(Lx,Vx,NewLx,NewVx) -> impose_nondom(NewLx,NewVx) ; true). :- mode impose_nondom(?,++). impose_nondom([],[]) :-!, fail. %deve fallire: e` un OR senza argomenti impose_nondom([X],[V]) :- !, X #< V. impose_nondom(Lx,Lv) :- make_suspension(nondominated(Lx,Lv),9,Susp), insert_suspension(Lx,Susp,min of fd, fd). %NOTA: In teoria dovrei sospendermi sia su min che su max of fd, %perche' il vincolo li verifica entrambi. Pero` se si modifica max, %il vincolo puo` solo uscire dal constraint store e non fa piu` %propagazione, quindi risvegliarlo prima o dopo cambia poco. %Nel caso min, invece, voglio risvegliarlo subito perche' potrebbe %fare del pruning :- mode strip_dominated_coords(?,++,?,-). strip_dominated_coords([],[],[],[]). strip_dominated_coords([X|Lx],[V|Lv],NewLx,NewLv) :- dvar_domain(X,Dom), dom_range(Dom,Min,Max), ( V > Max -> fail % vincolo soddisfatto ; (V =< Min %dominated_coord(Min,Max,V) -> NewLx=TempLx, NewLv=TempLv ; NewLx=[X|TempLx], NewLv=[V|TempLv])), strip_dominated_coords(Lx,Lv,TempLx,TempLv). %dominated_coord(M,M,M):- !. %dominated_coord(Min,_,V) :- V =< Min. check_nondominated(Lx,Vx) :- (strip_dominated_coords(Lx,Vx,NewLx,NewVx) -> check_nondom(NewLx,NewVx) ; true). :- mode check_nondom(?,++). check_nondom([],[]) :-!, fail. %deve fallire: e` un OR senza argomenti check_nondom([X],[V]) :- !, X #< V. check_nondom(_,_). %%%%%%%%%%%%%%%%%%% QUAD-TREES %%%%%%%%%%%%%%%%%%% propagate_unback(Store,[F1,F2]) :- !, mindomain(F1,Min1), propagate_domination(Store,[Min1,F2]), mindomain(F2,Min2), propagate_domination(Store,[F1,Min2]). % mindomain(F1,Min1N), % (Min1N=Min1 % -> true % ; propagate_unback(Store,[Min1N,F2])), % mindomain(F2,Min2N), % (Min2N=Min2 % -> true % ; propagate_unback(Store,[F1,Min2N])). propagate_unback(_Store,List) :- List \= [_,_], !, error(4, troppe_funzioni, pcop). :- mode propagate_domination(++,?). propagate_domination([],_). propagate_domination(quad with [cost:[Long,Lat],nw:NW,se:SE],[X,Y]) :- check_nondominated([X,Y],[Long,Lat]), dvar_domain(X,DomX), dom_range(DomX,MinX,MaxX), dvar_domain(Y,DomY), dom_range(DomY,MinY,MaxY), (MaxX > Long, MinY < Lat -> propagate_domination(SE,[X,Y]) ; true), % maxdomain(Y,MaxY), (MaxY > Lat, MinX < Long -> propagate_domination(NW,[X,Y]) ; true). insert_in_store(StoreIn,Solution,StoreOut) :- insert_in_store(StoreIn,Solution,StoreTemp,Reinsert), reinsert(StoreTemp,Reinsert,StoreOut). :- mode reinsert(+,+,?). reinsert(Sin,[],Sin) :- !. reinsert(Sin,quad with [cost:Cost,nw:NW,se:SE,solution:Sol],Sout):- insert_in_store(Sin,sol(Sol,Cost),Stemp,Reinsert), reinsert(Stemp,NW,St2), reinsert(St2,SE,St3), reinsert(St3,Reinsert,Sout). % insert_in_store(+Store_in,+Solution,-Store_out,-reinsert) % reinsert is a quadtree of values to be re-inserted. insert_in_store([],sol(Sol,Cost),quad with [cost:Cost,nw:[],se:[],solution:Sol],[]). % Try to avoid no_solutions in the root: % If the store only contains no_solution, re-insert no_solution % DID NOT GIVE GOOD RESULTS % Insert in NW quadrant insert_in_store(Node,sol(Sol,[CX,CY]),QuadOut,Reinsert) :- Node = quad with [cost:[NodeCX,NodeCY],nw:NW,se:SE,solution:NodeSol], CX < NodeCX, CY > NodeCY, !, %no_solution are always leaves: %if I find one, I put the current node in its position and %I reinsert the subtree rooted in a no_solution node % It is always slower!!! % (NodeSol=no_solution, Sol\=no_solution % -> QuadOut=quad with [cost:[CX,CY],nw:[],se:[],solution:Sol], % Reinsert = Node % ; QuadOut = quad with [cost:[NodeCX,NodeCY],nw:QuadTemp,se:SE,solution:NodeSol], insert_in_store(NW,sol(Sol,[CX,CY]),QuadTemp,Reinsert). % Insert in SE quadrant insert_in_store(Node,sol(Sol,[CX,CY]),QuadOut,Reinsert) :- Node = quad with [cost:[NodeCX,NodeCY],nw:NW,se:SE,solution:NodeSol], CX > NodeCX, CY < NodeCY, !, %no_solution are always leaves... % (NodeSol=no_solution, Sol\=no_solution % -> QuadOut=quad with [cost:[CX,CY],nw:[],se:[],solution:Sol], % Reinsert = Node % ; QuadOut = quad with [cost:[NodeCX,NodeCY],nw:NW,se:QuadTemp,solution:NodeSol], insert_in_store(SE,sol(Sol,[CX,CY]),QuadTemp,Reinsert). % insert in NE: the point is dominated, we don't have to insert it insert_in_store(Node,sol(_,[CX,CY]),Node,[]) :- Node = quad with [cost:[NodeCX,NodeCY]], CX >= NodeCX, CY >= NodeCY, !. % ([CX,CY]=[NodeCX,NodeCY] -> % writeln("Attempt to insert an equal solution in Unbacktrackable Constraint % Store") % ; writeln("Attempt to insert a dominated solution in Unbacktrackable Constraint Store")). % Insert in SW quadrant: The point dominates the node. % The point becomes the new root and we delete all the dominated % solutions in the store. insert_in_store(Node,sol(Sol,[CX,CY]),QuadOut,[]) :- Node = quad with [cost:[NodeCX,NodeCY],nw:NW,se:SE], % CX =< NodeCX, CY =< Node CY, !, QuadOut = quad with [cost:[CX,CY],nw:NewNW,se:NewSE,solution:Sol], delete_dominated(NW,[CX,CY],NewNW,[NodeCX,NodeCY]), delete_dominated(SE,[CX,CY],NewSE,[NodeCX,NodeCY]). % delete_dominated(QuadIn,Point,QuadOut,Root of tree), % VERY STUPID DELETION METHOD!!! % the information about the root could be used to delete subtrees delete_dominated([],_,[],_). delete_dominated(QuadIn,[CX,CY],QuadOut,_) :- QuadIn = quad with [cost:[NodeCX,NodeCY],nw:NW,se:SE,solution:Sol], (NodeCX > CX -> delete_dominated(NW,[CX,CY],NewNW,_) ; NewNW=NW), (NodeCY > CY -> delete_dominated(SE,[CX,CY],NewSE,_) ; NewSE=SE), (dominates([CX,CY],[NodeCX,NodeCY]) -> (NewNW=[], NewSE=[] -> QuadOut=[] ; QuadOut = quad with [cost:[NodeCX,NodeCY],nw:NewNW,se:NewSE,solution:deleted] ) ; QuadOut= quad with [cost:[NodeCX,NodeCY],nw:NewNW,se:NewSE,solution:Sol]).Received on Thu Apr 29 2010 - 09:26:24 CEST
This archive was generated by hypermail 2.2.0 : Thu Feb 02 2012 - 02:31:58 CET